home *** CD-ROM | disk | FTP | other *** search
/ ASME's Mechanical Engine…ing Toolkit 1997 December / ASME's Mechanical Engineering Toolkit 1997 December.iso / basic / qbuddy21.lzh / QBACCT.BAS < prev    next >
BASIC Source File  |  1988-03-24  |  62KB  |  1,566 lines
  1. DECLARE SUB fclose (handle%)
  2. DECLARE SUB fopen (Fil$, faccess%, fmode%, test.handle%, ercd%)
  3. DECLARE SUB SetFattr (Fil$, attr%)
  4. DECLARE SUB fcreate (Fil$, attr%, test.handle%, ercd%)
  5. DECLARE SUB fread (handle%, BUFFER%, bytes%, bytesread%, ercd%)
  6. DECLARE SUB fsetend (handle%)
  7. DECLARE SUB fsetrec (handle%, recsize%, recno%)
  8. DECLARE SUB fwrite (test.handle%, BUFFER%, bytes%, byteswritten%, ercd%)
  9. DECLARE SUB GetAttrF (attr%)
  10. DECLARE SUB setdrv (SYS.PATH$)
  11. DECLARE SUB getdrv (SYS.PATH$)
  12. DECLARE SUB setsub (TMP$, ercd%)
  13. DECLARE SUB getsub (SUB$, slen%)
  14. DECLARE SUB getcrt (colordisp%)
  15. DECLARE SUB getkbd (INSERT%, capslock%, numlocl%, scrolllock%)
  16. DECLARE SUB GetDateF (mnth%, day%, year%)
  17. DECLARE SUB getdosv (maj%, min%)
  18. DECLARE SUB getfdate (Fil$, mnth%, day%, year%)
  19. DECLARE SUB getkey (GOODKEY$, KY$)
  20. DECLARE SUB GetNameF (Fil$, flen%)
  21. DECLARE SUB locase (MSG$)
  22. DECLARE SUB upcase (MSG$)
  23. DECLARE SUB month (mnth$, mlenth%, monthnumber%)
  24. DECLARE SUB setdrv (DRV$)
  25. DECLARE SUB setpoint (col%, row%)
  26. DECLARE SUB soundex (WORD$, SCODE$, slen%)
  27. DECLARE SUB subexist (SUBDIR$, valid%)
  28. DECLARE SUB tinstr (ST$, chrtype%, place%)
  29. DECLARE SUB FindNextF (ercd%)
  30. DECLARE SUB FindFirstF (Fil$, attr%, RCD%)
  31. DECLARE SUB mwindow (lfcol%, toprow%, rtcol%, botrow%)
  32. DECLARE SUB mprint (ST$, col%, row%)
  33. DECLARE SUB mmcheck (mouse%)
  34. DECLARE SUB equipment (memory%, parallel%, seriel%, game%)
  35. DECLARE SUB makewindow (LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, PAGE%)
  36. DECLARE SUB Help (CLIENT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, VER$, fc%, bc%, SYS.PATH$)
  37. DECLARE SUB hold ()
  38. DECLARE SUB Sclr (fc%, bc%)
  39. DECLARE SUB tyme ()
  40. DECLARE SUB menu (fgd!, BKGD!, brdr!, CLIENT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, VER$, fc%, bc%, today.date.str$, inflg%, SYS.PATH$)
  41. DECLARE SUB box (r1%, c1%, R2%, c2%, men%)
  42. DECLARE SUB box.text (MSG$, row%, col%, front, back, ofront, oback)
  43. DECLARE SUB center (whichline!, tl$)
  44. DECLARE SUB rsmg (whichline!, tl$)
  45. DECLARE SUB CreateFile (Filename$)
  46. DECLARE SUB ScanFile (Filename$)
  47. DECLARE SUB PrintFile (Filename$)
  48. DECLARE SUB AppendFile (Filename$)
  49. DECLARE SUB infile (CLIENT.PATH$, APT.PATH$, inflg%, Filename$, fc%, bc%, SYS.PATH$, ercd%, handle%, faccess%, mode%, SUB.PATH$)
  50. DECLARE SUB SCROLL (lfcol%, toprow%, rtcol%, botrow%, numlines%)
  51. DECLARE SUB strip (MSG$, CH$, MLEN%)
  52. DECLARE SUB stripblanks (ST$, stripwhich%, slen%)
  53. DECLARE SUB clreol
  54. DECLARE SUB bkspace (col%, row%)
  55. DECLARE SUB delchr (row%, col%)
  56. DECLARE SUB dosinkey (chrcode%, chrtype%)
  57. DECLARE SUB rrotate (ST$)
  58. Joe: ' QBUDDY
  59. endofdata = FALSE
  60. ON ERROR GOTO 40000
  61. ' INITIALIZE VARIABLES
  62.     KEY OFF: EL = 0: EN = 0: KEY 1, CHR$(201): KEY 2, CHR$(202): KEY 3, CHR$(203): KEY 4, CHR$(204): KEY 5, CHR$(205)
  63.     KEY 6, CHR$(206): KEY 7, CHR$(207): KEY 8, CHR$(208): KEY 9, CHR$(209)
  64.     DEF fnf$ (x) = RIGHT$("0" + MID$(STR$(x), 2), 2)
  65.     DIM API$(16), item%(16), j(16), Y(16), x(16), TC$(25), AC$(25), MD(12), MO$(12), DA$(8), H(16), V(16), LN(16), TD$(34), APT.PAT.NUM%(6, 34), APT.NAME$(6, 34), LOCKS$(3)
  66.     DEF SEG = 0: IF (PEEK(&H410) AND &H30) <> &H30 THEN HL = 15
  67.     YES = NOT NO: NO = NOT YES
  68.     LOCKS$(0) = STRING$(7, 219): LOCKS$(1) = STRING$(4, 219) + "NUM"
  69.     LOCKS$(2) = "CAP" + STRING$(4, 219): LOCKS$(3) = "CAP" + CHR$(219) + "NUM"
  70.     NTR$ = CHR$(13): BKSP$ = CHR$(8): ESC$ = CHR$(27): UP$ = CHR$(24): DN$ = CHR$(25): RT$ = CHR$(26): LF$ = CHR$(27): BREAK$ = CHR$(3)
  71.     ENTR$ = " " + CHR$(17) + STRING$(2, 196) + CHR$(217) + " "
  72.     NUMS = 1: CAPS = 2: CLS
  73.     LF.CURSOR = 75: RT.CURSOR = 77: END.KEY = 79: INS.KEY = 82: DEL.KEY = 83: HOME = 71: DN.CURSOR = 80: UP.CURSOR = 72: CTRL.END = 117: ESC = 27: CTRL.RT = 116: CTRL.LF = 115: PG.UP = 73: PG.DN = 81
  74.     H(1) = 20: V(1) = 4: LN(1) = 20 'last
  75.     H(2) = 20: V(2) = 5: LN(2) = 20 'first
  76.     H(3) = 20: V(3) = 6: LN(3) = 20 'street
  77.     H(4) = 20: V(4) = 7: LN(4) = 17 'city
  78.     H(5) = 20: V(5) = 8: LN(5) = 2   'st
  79.     H(6) = 20: V(6) = 9: LN(6) = 10 'zip
  80.     H(7) = 20: V(7) = 10: LN(7) = 13 'tele1
  81.     H(8) = 20: V(8) = 11: LN(8) = 13 'tele2
  82.     H(9) = 63: V(9) = 4: LN(9) = 7 'contract total
  83.     H(10) = 63: V(10) = 5: LN(10) = 7 'dwnpay$
  84.     H(11) = 63: V(11) = 6: LN(11) = 7 'bal$
  85.     H(12) = 63: V(12) = 7: LN(12) = 7 'MoPmt$
  86.     H(13) = 55: V(13) = 8: LN(13) = 10 'Due date
  87.     H(14) = 55: V(14) = 9: LN(14) = 15 'notes
  88.     H(15) = 63: V(15) = 10: LN(15) = 10 'Pmt date
  89.     H(16) = 63: V(16) = 11: LN(16) = 7 'AmtPaid$
  90.     DIM SHARED m$(10), np, CH, yn$, text$(10), col$(15)
  91.     DIM NOYES$(2): NOYES$(0) = "NO ": NOYES$(1) = "YES"
  92.     DIM YESNO$(2): YESNO$(0) = "YES": YESNO$(1) = "NO "
  93.     DIM ONOFF$(2): ONOFF$(0) = "OFF": ONOFF$(1) = "ON "
  94.     DIM MON$(4): MON$(0) = "40x25 Mono ": MON$(1) = "40x25 Color": MON$(2) = "80x25 Color": MON$(3) = "80x25 Mono "
  95.     DIM HRDSK$(16): DIM SYSBRD(16): DIM SHARED SETMM(16)
  96.        
  97.     B1$ = CHR$(196) + CHR$(210)
  98.     B1$ = CHR$(218) + B1$ + B1$ + B1$ + B1$ + B1$ + B1$ + B1$ + CHR$(196) + CHR$(191)
  99.     B2$ = " " + CHR$(186)
  100.     B2$ = CHR$(179) + B2$ + B2$ + B2$ + B2$ + B2$ + B2$ + B2$ + " " + CHR$(179)
  101.     B3$ = B2$
  102.     B4$ = CHR$(196) + CHR$(208)
  103.     B4$ = CHR$(192) + B4$ + B4$ + B4$ + B4$ + B4$ + B4$ + B4$ + CHR$(196) + CHR$(217)
  104.  
  105.     Y(1) = 8: x(1) = 20: Y(2) = 10: x(2) = 20: Y(3) = 12: x(3) = 20: Y(4) = 14: x(4) = 20
  106.     MD(1) = 31: MD(3) = 31: MD(4) = 30: MD(5) = 31: MD(6) = 30: MD(7) = 31: MD(8) = 31: MD(9) = 30: MD(10) = 31: MD(11) = 30: MD(12) = 31
  107.     MO$(1) = "JANUARY": MO$(2) = "FEBRUARY": MO$(3) = "MARCH": MO$(4) = "APRIL": MO$(5) = "MAY": MO$(6) = "JUNE": MO$(7) = "JULY": MO$(8) = "AUGUST": MO$(9) = "SEPTEMBER": MO$(10) = "OCTOBER": MO$(11) = "NOVEMBER": MO$(12) = "DECEMBER"
  108.     DA$(1) = "MONDAY": DA$(2) = "TUESDAY": DA$(3) = "WEDNESDAY": DA$(4) = "THURSDAY": DA$(5) = "FRIDAY": DA$(6) = "SATURDAY": DA$(7) = "SUNDAY": DA$(8) = "ERROR"
  109.     HB1$ = CHR$(196): HB2$ = CHR$(205): HB3$ = CHR$(220): VB1$ = CHR$(179): VB2$ = CHR$(186): VB3$ = CHR$(219): ULC1$ = CHR$(218): URC1$ = CHR$(191): LLC1$ = CHR$(192): LRC1$ = CHR$(217): ULC2$ = CHR$(201): URC2$ = CHR$(187): LLC2$ = CHR$(200): _
  110.                                                                                           LRC2$ = CHR$(188)
  111.     ULC3$ = CHR$(220): URC3$ = CHR$(220): LLC3$ = CHR$(219): LRC3$ = CHR$(219): ML11$ = CHR$(195): MR11$ = CHR$(180): ML22$ = CHR$(204): MR22$ = CHR$(185): HB771$ = STRING$(77, HB1$): HB772$ = STRING$(77, HB2$): HB773$ = STRING$(77, HB3$): SP77$ _
  112.  = STRING$(77, 32)
  113.     ENTSYMB$ = CHR$(17) + CHR$(196) + CHR$(196) + CHR$(217)
  114.     PARAM$ = "AMPARAM.DAT"
  115.     H1$ = STRING$(80, 61): CLR$ = STRING$(80, 32): H5$ = STRING$(80, 31)
  116.     DATA Black,Blue,Green,Cyan,Red,Magenta,Brown-Yellow,White,Gray,Light Blue,Light Green,Light Cyan,Light Red,Light Magenta,Yellow,High-White
  117.     FOR L = 0 TO 15: READ col$(L): NEXT L
  118.     LCOL% = 5: TROW% = 5: RCOL% = 79: BROW% = 20: PAGE% = 0: FRAME% = 1: ty% = 3
  119.  
  120. 'Use this to initialize AMAC.DAT
  121. 'SYS.PATH$ = "C:\": SUB.PATH$ = "\QB": Client.PATH$ = "C:\CLIENT\": APT.PATH$ = "C:\APPOINT\"
  122. 'PRINTER$ = "APPLE DMP": PROG.NAME$ = "QBUDDY 1.4": ver$ = " QB 1.4 ": fc% = 15: bc% = 1
  123. 'GOSUB write.parm: END
  124.  
  125. GOSUB read.parm: GOSUB 50000: GOSUB 4000: CLS : END
  126. write.parm: '==========================================================
  127.     AMAC8$ = "QBUDDY.DAT"
  128.     OPEN AMAC8$ FOR OUTPUT AS #1
  129.     WRITE #1, SYS.PATH$, PAT.PATH$, APT.PATH$, ACT.PATH$, PROG.NAME$, fc%, bc%, SUB.PATH$, PRINTER$, VER$
  130.     CLOSE #1
  131. RETURN
  132.  
  133. read.parm: '===========================================================
  134.     AMAC8$ = "QBUDDY.DAT"
  135.     OPEN AMAC8$ FOR INPUT AS #1
  136.     INPUT #1, SYS.PATH$, PAT.PATH$, APT.PATH$, ACT.PATH$, PROG.NAME$, fc%, bc%, SUB.PATH$, PRINTER$, VER$
  137.     CLOSE #1
  138.     DRV$ = SYS.PATH$ + CHR$(0)
  139. 'CALL setdrv(DRV$)
  140. 'SUB$ = SUB.PATH$ + CHR$(0)
  141. 'CALL setsub(SUB$, ercd%)
  142. GOSUB prninfo: RETURN
  143. prninfo:
  144.         ESC$ = CHR$(27): HT$ = CHR$(9)
  145.         INIT.PTR$ = CHR$(17)
  146.         SET.TABS$ = CHR$(27) + CHR$(40) + "010,031,051,071,091,111,131."
  147.         condensed.on$ = CHR$(27) + "Q"
  148.         condensed.off$ = CHR$(27) + "N"
  149.         bold.on$ = CHR$(27) + "!"
  150.         bold.off$ = CHR$(27) + CHR$(34)
  151.         elongate.on$ = CHR$(14)
  152.         elongate.off$ = CHR$(15)
  153.         underline.on$ = ESC$ + "X"
  154.         underline.off$ = ESC$ + "Y"
  155.     RETURN
  156.  
  157.  
  158. Read.Prnfile:
  159.     OPEN prnfile$ FOR INPUT AS #1
  160.     INPUT #1, PRINTER$, ESC$, HT$, INIT.PTR$, SET.TABS$, TAB.STR$, condensed.on$, condensed.off$, bold.on$, bold.off$, elongate.on$, elongate.off$, underline.on$, underline.off$
  161.     CLOSE #1
  162. 200 'todate
  163. 201 '
  164.      TODAY.DATE$ = DATE$: TODAY.MONTH% = VAL(LEFT$(TODAY.DATE$, 2))
  165.      MONTH.TP% = TODAY.MONTH%
  166.      TODAY.DAY% = VAL(MID$(TODAY.DATE$, 4, 2))
  167.      DAY.TP$ = STR$(TODAY.DAY%): DAY.TP% = TODAY.DAY%
  168.      TODAY.YEAR% = VAL(RIGHT$(TODAY.DATE$, 2))
  169.      YEAR.TP% = TODAY.YEAR%
  170.      YEAR.TP$ = STR$(YEAR.TP%)
  171.      GOSUB 30350
  172.      today.date.str$ = DATE.STR.TP$
  173.      TODAY.DC% = DC: TODAY.MAX.DAYS% = MAX.DAYS%
  174.      RETURN
  175.  
  176. 300 'Center
  177.      CALL center(V, a$): RETURN
  178. 350 'Option
  179.     LOCATE 12, 30: COLOR 0, 14: PRINT "OPTION NOT AVAILABLE"; : COLOR fc%, bc%: FOR L = 1 TO 1500: NEXT L: LOCATE 25, 1: PRINT CLR$; : RETURN
  180. 385 '
  181. 390 'Numeric
  182.     NUM.ERR% = 0
  183.     FOR L% = 1 TO LEN(IN.STRING$): a = ASC(MID$(IN.STRING$, L%, 1))
  184.         IF a <= 47 OR a >= 58 THEN NUM.ERR% = 1: RETURN ELSE GOTO 402
  185. 402 NEXT L%: IN.NUM% = VAL(LEFT$(IN.STRING$, 4)): RETURN
  186. 403 '
  187. 490 'String
  188.  
  189. IN.STRING$ = "": in.line% = CSRLIN: in.column% = POS(0)
  190. 510 COLOR fc% + 16, bc%: PRINT CHR$(16); : COLOR fc%, bc%
  191. 520 a$ = INKEY$: IF a$ = "" THEN 520 ELSE a = ASC(a$)
  192.     IF a = 27 THEN 600
  193.     IF a = 8 THEN GOSUB 640: GOTO 520
  194.     IF a = 13 THEN LOCATE CSRLIN, POS(0) - 1: COLOR fc%, bc%: PRINT " "; : RETURN
  195.     IF a < 32 OR a > 126 THEN BEEP: GOTO 520
  196.     IF POS(0) - 1 THEN LOCATE CSRLIN, POS(0) - 1
  197.     PRINT a$; : IN.STRING$ = IN.STRING$ + a$: GOTO 510
  198. 600 '[ESC] KEY
  199. 610 IF IN.STRING$ = "" THEN LOCATE CSRLIN, POS(0) - 1: PRINT "  "; : RETURN
  200. 620 LOCATE in.line%, in.column%: PRINT SPACE$(LEN(IN.STRING$) + 1); : LOCATE in.line%, in.column%: IN.STRING$ = "": GOTO 510
  201. 640 ' BACKSPACE
  202. 650 IF IN.STRING$ = "" THEN BEEP: RETURN
  203. 660 IN.STRING$ = LEFT$(IN.STRING$, LEN(IN.STRING$) - 1): LOCATE CSRLIN, POS(0) - 2: PRINT "  "; : LOCATE CSRLIN, POS(0) - 2: COLOR fc% + 16, bc%: PRINT CHR$(16); : COLOR fc%, bc%: RETURN
  204.  
  205. tyme:
  206. 700 CALL tyme
  207.     RETURN
  208.  
  209. 1000 'INKEY
  210. 1010 a$ = INKEY$: IF a$ = "" THEN 1010 ELSE a = ASC(a$): RETURN
  211.  
  212. 4000 '======================== MAIN MENU ==================================
  213. GOSUB 200
  214.  
  215. Second.title$ = "ACCOUNTS  RECEIVABLE"
  216. bottom.msg$ = VER$
  217.  
  218. '
  219. first.menu:
  220.     m$(1) = "Accounting Files"
  221.     m$(2) = "Perpetual Calendar"
  222.     m$(3) = "RESERVED"
  223.     m$(4) = "Run SETUP"
  224.     m$(5) = "System Information"
  225.     m$(6) = "EXIT TO DOS"
  226. 4001 ' Redraw
  227. np = 6
  228. COLOR fc%, bc%
  229. CLS
  230. LABEL$ = "Main Menu"
  231. CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, 4, 3, fc%, bc%, PAGE%)
  232. 'box 1, 1, 25, 79, 1
  233. CALL center(2, "QBUDDY") 'Prints the first menu title
  234. CALL center(3, Second.title$)
  235. CALL center(23, bottom.msg$)
  236.  
  237. CALL getcrt(colordisp%)
  238. IF colordisp% THEN GOSUB crtcolor ELSE LOCATE 24, 9: PRINT "Mono";
  239. CALL getkbd(INSERT%, capslock%, numlocl%, scrolock%)
  240. IF capslock% THEN LOCATE 24, 56: PRINT "CAPS";
  241. IF numlocl% THEN LOCATE 24, 50: PRINT "NUM";
  242. IF scrolock% THEN LOCATE 25, 56: PRINT "SCRL";
  243. fc = fc%: bc = bc%
  244. CALL menu(fc, bc, bc, CLIENT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, VER$, fc%, bc%, today.date.str$, inflg%, SYS.PATH$)
  245. IF INSERT% THEN LOCATE 25, 50: PRINT "INS";
  246.  
  247. CLS
  248. a = CH
  249.      IF a = 2 THEN GOSUB 30470: GOTO 4000
  250.      IF a = 1 THEN GOSUB file.work: GOTO 4000
  251.      IF a = 3 THEN GOSUB 350: GOTO 4000
  252.      IF a = 4 THEN CLEAR : CHAIN "QBUDDYSU.BAS"
  253.      IF a = 5 THEN GOSUB helpout: GOTO 4000
  254.      IF a = 6 THEN RETURN
  255.  
  256. crtcolor:
  257.     C$ = "Color"
  258.     FOR x = 1 TO LEN(C$)
  259.         LET$ = MID$(C$, x, 1)
  260.         LOCATE 24, 36 + x
  261.         COLOR 15, x
  262.         PRINT LET$;
  263.     NEXT x
  264. COLOR fc%, bc%
  265. RETURN
  266.  
  267. 4400 'Screen Clear
  268.        
  269. helpout:
  270. CALL Help(CLIENT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, VER$, fc%, bc%, SYS.PATH$)
  271. RETURN
  272.  
  273.  
  274. '============================= FILE WORK MENU ==============================
  275. file.work:
  276. bottom.msg$ = VER$
  277.  
  278.     m$(1) = "ACCOUNTS RECEIVABLE"
  279.     m$(2) = "FORMAT NEW Accounting Directory"
  280.     m$(3) = "Scan Directories for Files"
  281.     m$(4) = "READ Text Files"
  282.     m$(5) = "RESERVED"
  283.     m$(6) = "EXIT to Main Menu"
  284.  
  285. np = 6
  286. COLOR fc%, bc%
  287. CLS
  288. LABEL$ = "Work with files"
  289. CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, PAGE%)
  290. CALL center(3, Second.title$)
  291. CALL center(23, bottom.msg$)
  292. fc = fc%: bc = bc%
  293. CALL menu(fc, bc, bc, CLIENT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, VER$, fc%, bc%, today.date.str$, inflg%, SYS.PATH$)
  294. a = CH
  295.      IF a = 1 THEN GOSUB 8300: GOTO file.work
  296.      IF a = 4 THEN inflg% = 0: GOSUB readafile: GOTO file.work
  297.      IF a = 3 THEN GOSUB dirscan: GOTO file.work
  298.      IF a = 2 THEN GOSUB 5350: GOTO file.work
  299.      IF a = 5 THEN GOSUB 350: GOTO file.work
  300.      IF a = 6 THEN RETURN
  301.  
  302. '=============== SCAN DIRECTORIES FOR FILE OR DIR LISTING =================
  303. dirscan:
  304.     
  305.     CALL infile(CLIENT.PATH$, APT.PATH$, inflg%, Filename$, fc%, bc%, SYS.PATH$, ercd%, handle%, faccess%, fmode%, SUB.PATH$)
  306.     a$ = STRING$(75, 32): center 23, a$
  307.     a$ = "Press any key": center 23, a$
  308.     RETURN
  309. '========================= READ A TEXT FILE ===============================
  310. readafile:
  311.     GOSUB dirscan
  312.     GOSUB read.it
  313.     inflg% = 0: RETURN
  314. read.it:
  315. 'LOCATE 24, 5: PRINT Filename$; : END
  316. 'Filename$ = Filename$ + CHR$(0)
  317.     CALL fopen(Filename$, 2, 0, handle%, ercd%)
  318.     IF ercd% THEN BEEP: GOTO close.it ELSE GOTO displayit
  319.     
  320. displayit:
  321.     CLS
  322.     CALL fclose(handle%)
  323.     Filename$ = RTRIM$(Filename$)
  324.     center 1, "Reading -> " + Filename$
  325.     V = 6
  326.     OPEN Filename$ FOR INPUT AS #1
  327.         WHILE NOT EOF(1)
  328.             LINE INPUT #1, BUFFER$
  329.             LOCATE V, 6: PRINT BUFFER$
  330.             V = V + 1
  331.             IF V >= 18 THEN GOSUB hold.it
  332.         WEND
  333.  
  334. view.it:
  335.     a$ = "Press a key to continue...": center 23, a$
  336.     a$ = INKEY$: IF a$ = "" THEN GOTO view.it
  337.     CLOSE #1: RETURN
  338.  
  339.  
  340. hold.it:
  341.     V = 6
  342.     a$ = "Press a key for next page...": center 23, a$
  343.     a$ = INKEY$: IF a$ = "" THEN GOTO hold.it ELSE CLS : RETURN
  344. close.it:
  345.     a$ = "  Unable to open " + Filename$ + "    ": center 23, a$
  346.     a$ = INKEY$: IF a$ = "" THEN GOTO close.it ELSE CLOSE #1: RETURN
  347.  
  348.  
  349. 5350 'FORMAT Client DISK/DIR
  350. LABEL$ = "Format New ACCOUNTING File Disk/Directory"
  351. CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, PAGE%)
  352.  
  353.     a$ = "Floppy disks must first be formatted using MS-DOS."
  354.     CALL center(6, a$)
  355.     a$ = "CAUTION: This command will erase existing QBUDDY data."
  356.     CALL center(7, a$)
  357.     a$ = "Directory paths are CRITICAL!": CALL center(8, a$)
  358.     LOCATE 10, 25: PRINT "F1 - FORMAT new ACCOUNTING files disk/directory";
  359.     LOCATE 12, 25: PRINT "ESC - EXIT Formatting";
  360.     LOCATE 14, 25: COLOR 15: PRINT "Enter selection ";
  361.     a$ = "ESCape to exit": center 23, a$
  362. 5355 a$ = INKEY$: IF a$ = "" GOTO 5355 ELSE a = ASC(a$)
  363.     IF a = 27 THEN RETURN
  364.     IF a = 201 THEN GOSUB 5425: RETURN
  365.     BEEP: GOTO 5355
  366. 5420 '
  367. 5425 'CREATE MASTER INDEX FILES
  368.     CLS
  369.     a$ = "CREATE AMAC/CLIENT INDEX FILES": center 6, a$
  370.     a$ = "Acceptable examples are... A:\  B:\   C:\Client\   D:\Client\": center 7, a$
  371.     a$ = "Use a \ (backslash) following the last path entry": center 8, a$
  372.     a$ = "Press ESC(ape) to EXIT.": center 23, a$
  373. 5450 LOCATE 10, 5: PRINT "Enter number of total records "; : GOSUB 490
  374.     IF IN.STRING$ = "" THEN RETURN
  375.     GOSUB 390: IN.NUM% = maxrecords%
  376.     LOCATE 10, 5: PRINT STRING$(40, 32);
  377.     LOCATE 12, 5: PRINT "Enter complete path name for Client files directory "; : GOSUB 490
  378.     LOCATE 12, 5: PRINT STRING$(68, 32): IF IN.STRING$ = "" THEN RETURN
  379. 5455 F$ = IN.STRING$ + "RECORD.IDX": LOCATE 14, 10: COLOR bc%, fc%: PRINT "CREATING "; F$;
  380.     COLOR fc%, bc%
  381.      OPEN "R", #1, F$, 2
  382.      FIELD #1, 2 AS NEXT.REC$: LSET NEXT.REC$ = MKI$(1): PUT #1, 1
  383. FOR L% = 2 TO maxrecords%
  384.      LSET NEXT.REC$ = MKI$(0): PUT #1, L%
  385. NEXT L%
  386.      CLOSE #1
  387.      LOCATE 14, 10: PRINT "CREATING INDEX FILE  .IDX"; SPC(20);
  388. FOR L% = 65 TO 90
  389.      LOCATE 14, 30: PRINT CHR$(L%); : index.file$ = IN.STRING$ + CHR$(L%) + ".IDX": OPEN "R", #1, index.file$, 2: FIELD #1, 2 AS REC.PTR$
  390.      LSET REC.PTR$ = MKI$(1): PUT #1, 1: CLOSE #1
  391. NEXT L%
  392. 'Dummy Record
  393.     API$(1) = "Angelo"
  394.     API$(2) = "Michael"
  395.     API$(3) = "123 Fir #21"
  396.     API$(4) = "Houston"
  397.     API$(5) = "Tx"
  398.     API$(6) = "77055-5555"
  399.     API$(7) = "(713)555-5555"
  400.     API$(8) = "(   )555-1212"
  401.     API$(9) = "   1650.00"
  402.     API$(10) = "    123.65"
  403.     API$(11) = "   1526.35"
  404.     API$(12) = "     45.00"
  405.     API$(13) = "06-15-1988"
  406.     API$(14) = "  INS = $266.88"
  407.     API$(15) = "06-25-1988"
  408.     API$(16) = "     35.00"
  409.     CLIENT.NUM% = 2
  410. GOSUB 6800
  411. RETURN
  412. 5490 IF ERL = 5460 THEN RESUME 5450
  413. 5500 'CLEAR HELP
  414. 5505 COLOR fc%, bc%: FOR V = 22 TO 24
  415.      LOCATE V, 5: PRINT SPC(68);
  416.      NEXT V: RETURN'Clear Help
  417.  
  418.  
  419. 6440 '
  420.  
  421. 6000 'Client REC MOD Joe Lincoln 4-5-85
  422. 6010 'INPT CLIENT NUM
  423. 6020 REC.NUM.ERR% = 0: GOSUB 490: IF IN.STRING$ = "" THEN RETURN
  424. 6040 GOSUB 390: IF NUM.ERR% > 0 OR IN.NUM% > 10000 THEN BEEP: REC.NUM.ERR% = 1: GOTO 6000
  425. 6060 CLIENT.NUM% = IN.NUM%: RETURN
  426. 6061 '
  427. 6100 'READ CLIENT REC
  428.      F$ = CLIENT.PATH$ + "RECORD.IDX": BLANK.REC% = 0: OPEN "R", #5, F$, 2: FIELD #5, 2 AS RI.LAST.REC$: GET #5, CLIENT.NUM%: RI.LAST.REC% = CVI(RI.LAST.REC$): CLOSE #5: IF RI.LAST.REC% = 0 THEN BLANK.REC% = 1: RETURN
  429.      F$ = CLIENT.PATH$ + "CLIENT.APT": OPEN "R", #1, F$, 185
  430. FIELD #1, 20 AS LAST.NAME$, 20 AS FIRST.NAME$, 20 AS STREET$, 17 AS CITY$, 2 AS STATE$, 10 AS ZIP$, 13 AS TELE1$, 13 AS TELE2$, 7 AS TOTAL$, 7 AS dwnpay$, 7 AS BAL$, 7 AS mopmt$, 10 AS duedate$, 15 AS NOTES$, 10 AS PMTDATE$, 7 AS AMTPAID$: GET #1,  _
  431. RI.LAST.REC%
  432.      API$(1) = LAST.NAME$
  433.      API$(2) = FIRST.NAME$
  434.      API$(3) = STREET$
  435.      API$(4) = CITY$
  436.      API$(5) = STATE$
  437.      API$(6) = ZIP$
  438.      API$(7) = TELE1$
  439.      API$(8) = TELE2$
  440.      API$(9) = TOTAL$
  441.      API$(10) = dwnpay$
  442.      API$(11) = BAL$
  443.      API$(12) = mopmt$
  444.      API$(13) = duedate$
  445.      API$(14) = NOTES$
  446.      API$(15) = PMTDATE$
  447.      API$(16) = AMTPAID$
  448.      CLOSE #1
  449.  
  450.  
  451.  
  452.  
  453. GOSUB accounting
  454. RETURN
  455.  
  456. 6540 'WRITE CLIENT REC
  457. 6550 '
  458.      F$ = CLIENT.PATH$ + "CLIENT.APT": OPEN "R", #1, F$, 185
  459.      FIELD #1, 20 AS LAST.NAME$, 20 AS FIRST.NAME$, 20 AS STREET$, 17 AS CITY$, 2 AS STATE$, 10 AS ZIP$, 13 AS TELE1$, 13 AS TELE2$, 7 AS TOTAL$, 7 AS dwnpay$, 7 AS BAL$, 7 AS mopmt$, 10 AS duedate$, 15 AS NOTES$, 10 AS PMTDATE$, 7 AS AMTPAID$: _
  460.        GET #1, RI.LAST.REC%
  461.      LSET LAST.NAME$ = API$(1)
  462.      LSET FIRST.NAME$ = API$(2)
  463.      LSET STREET$ = API$(3)
  464.      LSET CITY$ = API$(4)
  465.      LSET STATE$ = API$(5)
  466.      LSET ZIP$ = API$(6)
  467.      LSET TELE1$ = API$(7)
  468.      LSET TELE2$ = API$(8)
  469.      LSET TOTAL$ = API$(9)
  470.      LSET dwnpay$ = API$(10)
  471.      LSET BAL$ = API$(11)
  472.      LSET duedate$ = API$(13)
  473.      LSET mopmt$ = API$(12)
  474.      LSET NOTES$ = API$(14)
  475.      LSET PMTDATE$ = API$(15)
  476.      LSET AMTPAID$ = API$(16)
  477.      PUT #1, RI.LAST.REC%
  478.      CLOSE #1
  479.      RETURN
  480. 6606 '
  481. 6800 'WRITE NEW CLIENT REC
  482. 6830 '
  483. 6840 F$ = CLIENT.PATH$ + "RECORD.IDX": OPEN "R", #5, F$, 2: FIELD #5, 2 AS RI.LAST.REC$: GET #5, 1: RI.LAST.REC% = CVI(RI.LAST.REC$) + 1: LSET RI.LAST.REC$ = MKI$(RI.LAST.REC%): PUT #5, 1
  484. 6842 LSET RI.LAST.REC$ = MKI$(RI.LAST.REC%): PUT #5, CLIENT.NUM%: CLOSE #5: GOSUB 6540: index.file$ = CLIENT.PATH$ + LEFT$(API$(1), 1) + ".IDX": ADD.REC% = 1: GOSUB 13200: RETURN
  485. 6843 '
  486. 7300 'INPUT CLIENT REC
  487. 7301 '
  488. 7302 REC.NUM.ERR% = 0: MATCHES% = 0: SCR.KEY$ = LEFT$(IN.STRING$, 20)
  489. 7310 a% = ASC(SCR.KEY$): IF a% > 47 AND a% < 58 THEN 7400
  490. 7312 IF (a% > 64 AND a% < 90) OR (a% > 96 AND a% < 123) THEN 7320
  491. 7314 REC.NUM.ERR% = 1: RETURN
  492. 7320 SCR.LEN% = LEN(SCR.KEY$)
  493.      FOR LP% = 1 TO SCR.LEN%
  494.      a% = ASC(MID$(SCR.KEY$, LP%, 1)): IF a% > 96 AND a% < 123 THEN MID$(SCR.KEY$, LP%, 1) = CHR$(a% - 32)
  495.      NEXT LP%
  496. 7326 index.file$ = CLIENT.PATH$ + LEFT$(SCR.KEY$, 1) + ".IDX": OPEN "R", #3, index.file$, 2: FIELD #3, 2 AS REC.PTR$: GET #3, 1: MAX.REC% = CVI(REC.PTR$)
  497. 7330 FOR L1% = 2 TO MAX.REC%
  498. 7331 GET #3, L1%: CLIENT.NUM% = CVI(REC.PTR$): GOSUB 6100
  499. 7332 IF SCR.KEY$ <> LEFT$(API$(1), SCR.LEN%) THEN 7340
  500. 7334 MATCHES% = MATCHES% + 1: IF MATCHES% = 1 THEN NM% = CLIENT.NUM%: M1$ = API$(1): M2$ = API$(2): M3$ = API$(3): GOTO 7340
  501. 7336 IF MATCHES% = 2 THEN GOSUB 7350
  502. 7338 PRINT TAB(2); : PRINT USING "####"; CLIENT.NUM%; : PRINT TAB(8); API$(1); " "; API$(2); : MATCHES% = MATCHES% + 1
  503. 7340 NEXT L1%: GOTO 7370
  504. 7342 IF a$ = CHR$(27) THEN 7370
  505. 7344 a$ = INKEY$: IF a$ = "" THEN 7344
  506. 7346 IF a$ = CHR$(27) THEN 7370 ELSE 7340
  507. 7350 LOCATE TOP.OF.DISP% + REDRAW%, 1
  508.      FOR LP% = 1 TO LINES.IN.DISP% - REDRAW%: PRINT STRING$(80, 32); : NEXT LP%
  509.      a$ = CHR$(192) + STRING$(77, 196) + CHR$(217)
  510.      LOCATE 17, 1: PRINT a$;
  511. 7352 IF REDRAW% = 0 THEN REDRAW% = 1: LOCATE TOP.OF.DISP%, 1: COLOR fc%, bc%: PRINT "RECORD #"; TAB(10); "LAST NAME"; TAB(32); "FIRST NAME"; : COLOR fc%, bc%
  512. 7354 VIEW PRINT TOP.OF.DISP% + 1 TO TOP.OF.DISP% + LINES.IN.DISP%: LOCATE TOP.OF.DISP% + 2, 1: COLOR fc%, bc%: PRINT TAB(2); : PRINT USING "####"; NM%; : PRINT TAB(8); M1$; " "; M2$; : RETURN
  513. 7355 '
  514. 7370 CLOSE #3: VIEW PRINT 1 TO 24: LOCATE 25, 1: COLOR fc%, bc%: PRINT STRING$(80, 32);
  515. 7372 IF MATCHES% = 0 THEN LOCATE 25, 34: COLOR fc%, bc%: PRINT " NO MATCHES "; : COLOR fc%, bc%
  516.      FOR T = 1 TO 1000
  517.      NEXT T
  518.      LOCATE 25, 34: PRINT "            ";
  519. 7374 IF MATCHES% = 1 THEN CLIENT.NUM% = NM%: GOSUB 6100: RETURN
  520. 7376 CLIENT.NUM% = 0: RETURN
  521. 7400 GOSUB 390: IF NUM.ERR% OR IN.NUM% > 10000 THEN REC.NUM.ERR% = 1: RETURN
  522. 7402 CLIENT.NUM% = IN.NUM%: GOSUB 6100: RETURN
  523. 7404 '
  524.  
  525.  
  526. 7860 'DRAW CLIENT REC SCRN
  527. 7862 'CLIENT FILES PAGE HEAD
  528.  
  529. 7866 COLOR fc%, bc%: CLS : RUL% = 3: CUL% = 1: RLR% = 17: CLR% = 79: BAR% = 1: GOSUB 35000: RUL% = 18: RLR% = 23: BAR% = 2: COLOR fc%, bc%: GOSUB 35000
  530. 7868 IF FUNKEY$ = "" THEN FUNKEY$ = "WORK WITH"
  531. 7870 LOCATE 1, 2: PRINT SPC(78); : LOCATE 1, 2: PRINT "CLIENT FILES  "; DATE$; "    "; : LOCATE 1, 31: COLOR fc%, bc%: PRINT FUNCTION$; : LOCATE 1, 41: COLOR fc%, bc%: PRINT " CLIENT RECORDS       RECORD # "; : LOCATE 1, 74
  532. 7900 '
  533. 7960 '
  534. 7980 '
  535. 8000    COLOR 7, bc%
  536.     LOCATE 4, 3: PRINT "LAST NAME      :";
  537.     LOCATE 5, 3: PRINT "FIRST NAME     :";
  538.     LOCATE 6, 3: PRINT "STREET ADDRESS :";
  539.     LOCATE 7, 3: PRINT "CITY           :";
  540.     LOCATE 8, 3: PRINT "STATE          :";
  541.     LOCATE 9, 3: PRINT "ZIP CODE       :";
  542.     LOCATE 10, 3: PRINT "RESIDENCE TELE :";
  543.     LOCATE 11, 3: PRINT "BUSINESS  TELE :";
  544.     LOCATE 4, 45: PRINT "TOTAL CONTRACT $ ";
  545.     LOCATE 5, 45: PRINT "DOWN PAYMENT   $ ";
  546.     LOCATE 6, 45: PRINT "BALANCE DUE    $ ";
  547.     LOCATE 8, 45: PRINT "DUE DATE:";
  548.     LOCATE 7, 45: PRINT "MONTHLY PMT    $ ";
  549.     LOCATE 9, 45: PRINT "NOTES:";
  550.     LOCATE 10, 45: PRINT "LAST PMT DATE :";
  551.     LOCATE 11, 45: PRINT "LAST PMT AMT  $ ";
  552.     center 12, STRING$(76, 196)
  553.     AA$ = STRING$(5, 247)
  554.     LOCATE 13, 7: PRINT "CURRENT "; AA$; " 30 "; AA$; " 60 "; AA$; " 90 "; AA$; " 120 "; AA$; " TOTAL DUE "; AA$;
  555.     center 15, STRING$(70, 32)
  556.         
  557.     
  558. 8015 COLOR fc%, bc%
  559. 8160 'HELP SCRN
  560. 8170 '
  561. 8180 GOSUB 11000: LOCATE 18, 5: COLOR fc%, bc%: PRINT "  FUNCTION KEY COMMANDS  "; : COLOR fc%, bc%
  562. 8200 '
  563. 8201 '
  564. 8205 GOSUB 11000: LOCATE 19, 28: COLOR fc%, bc%: PRINT "F1 = GET CLIENT RECORD"; : LOCATE 20, 28: PRINT "F2 = ADD CLIENT RECORD";
  565. 8210 LOCATE 21, 28: PRINT "F3 = DELETE RECORD     "; : LOCATE 22, 28: PRINT "ESC = EXIT"; : LOCATE 23, 65: COLOR fc%, bc%: PRINT " ? = HELP "; : COLOR fc%, bc%: RETURN
  566. 8215 '
  567. 8300 'WORK WITH CLIENT
  568. 8301 '
  569. 8302 CLIENT.NUM% = 0: GOSUB 7860
  570. 8400 LOCATE 19, 25: BEEP: COLOR 31, bc%: PRINT CHR$(16);
  571. 8420 LOCATE 1, 30: COLOR fc%, bc%: PRINT " WORK WITH  "; : LOCATE 1, 74: PRINT "     ";
  572. 8440 GOSUB 1000
  573. 8450 LOCATE 23, 65: COLOR fc%, bc%: PRINT STRING$(10, 205);
  574. 8460 IF a = 27 THEN RETURN
  575. 8470 IF a$ = "?" OR a$ = "/" THEN FUNKEY$ = " HELP WITH ": GOSUB 8680: GOSUB 8840: GOSUB 8160: FUNKEY$ = " WORK WITH ": GOSUB 8680: GOTO 8440
  576. 8480 IF a = 201 THEN FUNKEY$ = "    GET   ": GOSUB 8680: GOSUB 11000: GOSUB 9800: GOSUB 8160: GOTO 8420
  577. 8482 IF a = 202 THEN FUNKEY$ = "    ADD   ": GOSUB 8680: GOSUB 11000: GOSUB 9000: GOSUB 8160: GOTO 8420
  578. 8484 IF a = 203 THEN GOSUB 10000: GOTO 8420
  579. 8490 BEEP: LOCATE 25, 30: COLOR 31, bc%: PRINT "INVALID ENTRY"; : LOCATE 23, 65: COLOR fc%, bc%: PRINT "? = HELP";
  580.      FOR x = 1 TO 1000
  581.      NEXT x
  582.      LOCATE 25, 30: COLOR fc%, bc%: PRINT SPC(13); : GOTO 8440
  583. 8500 IF a = 202 THEN FUNKEY$ = "    ADD   ": GOSUB 8680: GOSUB 11000: GOSUB 9000: LOCATE 25, 1: PRINT CLR$; : GOSUB 11000: GOSUB 8160: GOTO 8420
  584. 8501 BEEP: LOCATE 25, 30: COLOR 31, bc%: PRINT "INVALID ENTRY"; : LOCATE 23, 65: COLOR fc%, bc%: PRINT "? = HELP";
  585.      FOR x = 1 TO 1000
  586.      NEXT x
  587.      LOCATE 25, 30: COLOR fc%, bc%: PRINT SPC(13); : GOTO 8440
  588. 8502 '
  589. 8670 '
  590. 8680 'FUNKEY$
  591. 8685 '
  592. 8700 LOCATE 1, 30: COLOR fc%, bc%: PRINT FUNKEY$; : RETURN
  593. 8720 '
  594. 8760 'TAB
  595. 8770 '
  596. 8780 CU = CU + 2: IF CU > 8 THEN CU = 4
  597. 8790 LOCATE V, H: PRINT " "; : V = CU: LOCATE V, H: PRINT CHR$(16); : RETURN
  598. 8820 '
  599. 8840 'HELP SCRN
  600. 8850 GOSUB 11000: LOCATE 19, 5: COLOR fc%, bc%: PRINT " Selection F1 allows you to PULL and VIEW an existing CLIENT record.";
  601. 8852 LOCATE 20, 5: PRINT " Simply enter the CLIENT'S last name or number when you are prompted.";
  602. 8855 LOCATE 21, 5: PRINT " Selection F2 allows you to ADD a new CLIENT record to master files.";
  603. 8860 LOCATE 22, 5: PRINT " Either option will enter the REVIEW/EDIT module for amending a record.  ";
  604. 8861 LOCATE 23, 65: PRINT " Any Key "; : a$ = INKEY$: IF a$ = "" THEN 8861 ELSE GOSUB 11000
  605. 8862 LOCATE 19, 5: COLOR fc%, bc%: PRINT "Selection F3 allows deleating CLIENT records. Enter CLIENT number.";
  606. 8863 LOCATE 20, 5: PRINT "Just pressing RETurn without any data cancels your first selection.";
  607. 8864 LOCATE 21, 5: PRINT "Last names can be searched by entering a letter(s) instead of numbers.";
  608.     LOCATE 22, 5: PRINT "ESCape sequences allow you to exit the CLIENT Files module.";
  609. 8865 a$ = INKEY$: IF a$ = "" THEN GOTO 8865 ELSE GOSUB 11000: RETURN
  610. 8870 RETURN
  611. 8875 '
  612. 9000 'ADD CLIENT REC
  613. 9001 '
  614. 9010 F$ = CLIENT.PATH$ + "RECORD.IDX"
  615. 9012 GOSUB 11000: LOCATE 20, 17: COLOR fc%, bc%: PRINT "Enter NEW record number or press [RET]"
  616. 9014 LOCATE 20, 56: GOSUB 6010: IF IN.STRING$ = "" OR CLIENT.NUM% = 0 THEN RETURN
  617. 9016 IF CLIENT.NUM% > 10000 OR CLIENT.NUM% < 2 THEN BEEP: RETURN
  618. 9018 GOSUB 6100: IF BLANK.REC% = 0 THEN GOSUB 9700: GOSUB 9811: RETURN
  619. 9030 LOCATE 1, 74: PRINT USING "####"; CLIENT.NUM%
  620.      FOR L% = 1 TO 16: API$(L%) = CHR$(255)
  621.      NEXT L%
  622.     ADD.REC% = 1
  623.     GOSUB 9250
  624.     GOSUB 9450
  625.     GOSUB 11000
  626.     RETURN
  627. 9250 'Editor joekey
  628. 9260 '
  629. 9300 '
  630. 9328 ' Edit Parse
  631.     GOSUB enterdata: RETURN
  632.  
  633. joekey:
  634. WD = 0: WS = 0: WL = 0: WI = 1: SOUND 80, .03: MOVE.IT = NO: KY = 0: in$ = INKEY$
  635. QX = POS(0): QY = CSRLIN
  636. QC$ = control$: control$ = "": IF QC$ = "" THEN QC = NO: GOTO pugin ELSE QC = YES
  637. IF INSTR("U#_", MID$(QC$, WI, 1)) = 0 THEN WI = WI + 1: GOTO pug1
  638. pugin:
  639.     CHAR.CODE = FIX(FL / 100): IF CHAR.CODE > 0 THEN FL = FL - CHAR.CODE * 100
  640.     IF PROMPT$ = "" THEN in$ = SPACE$(FL): GOTO pug2
  641.     in$ = LEFT$(PROMPT$ + SPACE$(FL), FL): WL = LEN(PROMPT$): PROMPT$ = ""
  642. pug1: IF MID$(in$, WL, 1) = " " THEN WL = WL - 1: IF WL >= 0 THEN GOTO pug1
  643. pug2: COLOR bc%, fc%
  644. pug3: LOCATE QY, QX, 1: PRINT in$;
  645. pug4: LOCATE QY, QX + WI - 1
  646. pug5: W$ = INKEY$: DEF SEG = &H40: QK = PEEK(&H17) AND 96:
  647.     IF QK1 <> QK THEN LOCATE 25, 73: PRINT LOCKS$(QK / 32); : QK1 = QK: SOUND 400 + QK, .3: GOTO pug4
  648.     IF W$ = "" THEN GOTO pug5
  649.     IF W$ = BREAK$ THEN GOTO lastpug
  650.     IF LEN(W$) = 1 THEN GOTO pug18 ELSE KY = ASC(RIGHT$(W$, 1))
  651.     IF QC THEN GOTO pug6
  652.     IF KY = INS.KEY THEN IF INSERT = NO THEN INSERT = YES: LOCATE , , , 4, 13: GOTO pug3 ELSE INSERT = NO:                             LOCATE , , , 13: GOTO pug5
  653. pug6: IF KY = RT.CURSOR THEN WI = WI - (WI < WL): GOTO pug4
  654.     IF KY = LF.CURSOR THEN WI = WI + (WI > 1): GOTO pug4
  655.     IF KY = DEL.KEY THEN IF NOT QC THEN in$ = LEFT$(in$, WI - 1) + RIGHT$(in$, FL - WI) + " ": WL = WL - 1: GOTO pug3 ELSE MID$(in$, WI, 1) = " ": GOTO pug3
  656.     IF INSERT THEN INSERT = NO: LOCATE , , , 13
  657.     IF KY = HOME THEN WI = 1: GOTO pug4
  658.     IF KY = END.KEY THEN WI = WL + 1: GOTO pug4
  659.     IF KY = CTRL.END THEN in$ = LEFT$(in$, WI - 1) + SPACE$(FL - WI + 1): WL = WI - 1: GOTO pug3
  660.     IF KY <> CTRL.RT OR WI = WL + 1 THEN GOTO pug7
  661. pug19:  WI = WI + 1: IF WI = WL + 1 THEN GOTO pug4 ELSE IF MID$(in$, WI - 1, 1) = " " THEN GOTO pug4 ELSE GOTO pug19
  662. pug7: IF KY <> CTRL.LF OR WI = 1 THEN GOTO pug8
  663.     QC$ = control$: control$ = "": IF QC$ = "" THEN QC = NO ELSE QC = YES
  664. pug20:  WI = WI - 1: IF WI = 1 THEN GOTO pug4 ELSE IF MID$(in$, WI - 1, 1) = " " THEN GOTO pug4 ELSE GOTO pug20
  665. pug8: MOVE.IT = YES: GOTO going
  666. pug18:  IF W$ = NTR$ THEN GOTO going
  667.     IF W$ = ESC$ THEN KY = ESC: MOVE.IT = YES: GOTO going
  668. pug21:  IF NOT QC THEN GOTO pug10
  669.     IF W$ <> BKSP$ THEN GOTO pug9
  670.     IF WI > 1 THEN WI = WI - 1: Q$ = MID$(QC$, WI, 1) ELSE GOTO pug3
  671.     IF INSTR("#U_", Q$) = 0 THEN GOTO pug21 ELSE MID$(in$, WI, 1) = " ": GOTO pug3
  672. pug9: IF WI > FL THEN GOTO pug10
  673.     Q$ = MID$(QC$, WI, 1)
  674.     IF Q$ = "#" THEN CHAR.CODE = NUMS: GOTO pug10
  675.     IF Q$ = "U" THEN CHAR.CODE = CAPS: GOTO pug11
  676.     IF Q$ = "_" THEN CHAR.CODE = 0: GOTO pug11
  677.     W$ = Q$: GOTO pug12
  678. pug10: IF CHAR.CODE = NUMS THEN IF (W$ = "-" AND WI > 1) OR W$ = "+" THEN in$ = W$ + in$: GOTO going:
  679. pug11: IF WI > FL THEN GOTO pug13
  680.     IF CHAR.CODE = 0 THEN IF W$ >= " " AND W$ <= "~" THEN GOTO pug12
  681.     IF CHAR.CODE = NUMS THEN IF W$ >= "0" AND W$ <= "9" THEN GOTO pug12
  682.     IF CHAR.CODE = CAPS THEN IF W$ >= "a" AND W$ <= "z" THEN W$ = CHR$(ASC(W$) - 32): GOTO pug12 ELSE IF W$ >= " " AND W$ < "a" THEN GOTO pug12
  683. pug13: IF W$ = BKSP$ THEN IF WI > 1 THEN in$ = LEFT$(in$, WI - 2) + RIGHT$(in$, FL - WI + 1) + " ": WL = WL - 1: WI = WI - 1: GOTO pug3
  684.     GOTO pug5
  685. pug12: IF NOT INSERT THEN MID$(in$, WI, 1) = W$ ELSE IF WL < FL THEN WL = WL + 1:      in$ = LEFT$(LEFT$(in$, WI - 1) + W$ + RIGHT$(in$, FL - WI + 1), FL): WI = WI + 1: GOTO pug3 ELSE GOTO pug5
  686.     IF WI > 1 THEN GOTO pug15
  687.     IF NOT QC THEN in$ = W$ + SPACE$(FL - 1): GOTO pug14
  688.     FOR QQ = 2 TO FL: IF INSTR("#u=UI_", MID$(QC$, QQ, 1)) > 0 THEN MID$(in$, QQ, 1) = " "
  689.     NEXT QQ
  690. pug14: LOCATE , QX: PRINT in$; : LOCATE , QX: WL = 1
  691. pug15: PRINT W$;
  692.     WI = WI + 1: IF WI > WL THEN WL = WI - 1
  693.     IF WI >= FL THEN GOTO pug16
  694.     IF QC THEN Q$ = MID$(QC$, WI, 1): IF INSTR("#Ul_", Q$) = 0 THEN W$ = Q$: GOTO pug12
  695. pug16: IF FL > 2 OR WL < FL THEN GOTO pug3
  696. going: COLOR fc%, bc%: LOCATE QY, QX, , 13: PRINT in$; : in$ = LEFT$(in$, WL): INSERT = NO: RETURN
  697.  
  698.     LOCATE 25, 29
  699.     U$ = "press|" + ENTR$ + "|to continue": GOSUB pug17: FL = 0: GOSUB joekey
  700.     RETURN
  701.  
  702. pug17: U = 1: ULEN = LEN(U$): U1 = fc%: U2 = 7
  703. pug22:  UU = INSTR(U, U$, "|"): UU = UU - (UU = 0) * (ULEN + 1): PRINT MID$(U$, U, UU - U); : U = UU + 1: SWAP U1, U2: COLOR U1: IF ULEN > U OR U = 1 THEN GOTO pug22 ELSE COLOR fc%, bc%
  704.     RETURN
  705. lastpug:
  706. RETURN
  707.  
  708. enterdata:
  709. GOSUB 11000: GOSUB 9502
  710. QK1 = 0: LOCATE 20, 9: U$ = UP$ + "-|Up a line |  " + DN$ + "-|Down a Line |  PgUp-|Last Name |  PgDn-|Enter Payment |": GOSUB pug17
  711. LOCATE 21, 10: PRINT "Cursor control keys";
  712. PRINT ":   "; LF$; "  "; RT$; "  CTRL"; LF$; "  CTRL"; RT$; "  Home  End  Ins  Del"
  713.  
  714. topgun: GOSUB accounting
  715.     
  716.     j = 1
  717.     item% = j
  718.     
  719. getiton:
  720.         
  721.         PROMPT$ = ""
  722.         LOCATE V(j), H(j): FL = LN(j)
  723.         QX = POS(0): QY = CSRLIN
  724.         
  725. 'build prompt
  726.         FOR x = QX TO QX + FL
  727.             LETTER$ = CHR$(SCREEN(QY, x))
  728.             PROMPT$ = PROMPT$ + LETTER$
  729.         NEXT x
  730.         
  731.         item% = j: API$(item%) = PROMPT$
  732.         LOCATE V(j), H(j)
  733.         GOSUB joekey
  734.         IF NOT MOVE.IT THEN GOTO chngit
  735. 'moveit:
  736.     IF KY = UP.CURSOR THEN GOTO uparrow
  737.     IF KY = DN.CURSOR THEN GOTO dnarrow
  738.     IF KY = PG.UP THEN j = 1: GOSUB saveasis: GOTO getiton
  739.     IF KY = PG.DN THEN j = 16: GOSUB saveasis: GOTO getiton
  740.     IF KY = ESC THEN RETURN
  741.  
  742. chngit: IF in$ <> "" THEN API$(j) = in$ ELSE API$(j) = PROMPT$
  743.     IF j < 16 THEN j = j + 1:  GOTO getiton
  744.     GOTO exitedit
  745.  
  746. uparrow:
  747.  
  748.     j = j + (j > 1): GOTO getiton
  749.  
  750. dnarrow:
  751.  
  752.     j = j - (j < 16): GOTO getiton
  753.     
  754. saveasis:
  755.     LETTER$ = ""
  756.     FOR item% = 1 TO 16
  757.         API$(item%) = ""
  758.         LOCATE V(item%), H(item%)
  759.         QX = POS(0): QY = CSRLIN
  760.  
  761.         FL = LN(item%)
  762.             FOR x = QX TO QX + FL
  763.                 LETTER$ = CHR$(SCREEN(QY, x))
  764.                 API$(item%) = API$(item%) + LETTER$
  765.             NEXT x
  766.             LETTER$ = ""
  767.     NEXT item%
  768.     RETURN
  769.     
  770.  
  771.  
  772. accounting:
  773.     calc1 = VAL(API$(9)) 'total due
  774.     calc2 = VAL(API$(10)) 'dwnpay
  775.     calc3 = VAL(API$(11)) 'orig.bal
  776.     calc4 = VAL(API$(16)) 'paid this time
  777.     calc5 = VAL(API$(12)) 'set for monthly pmt of
  778.       
  779.     tempbal = calc3 - calc4
  780.     calc3 = tempbal
  781.     current = calc4
  782.     paydate = VAL(API$(15))
  783.     duedate = VAL(API$(12))
  784.     flagdate = duedate - paydate
  785.     IF flagdate <= 0 THEN flagdate = 1' past due
  786.     IF flagdate >= 1 THEN flagdate = 0'current
  787.     calc1 = VAL(API$(9)) 'total due
  788.     calc2 = VAL(API$(10)) 'dwnpay
  789.     calc3 = VAL(API$(11)) 'orig.bal
  790.     calc4 = VAL(API$(16)) 'paid this time
  791.     calc5 = VAL(API$(12)) 'set for monthly pmt of
  792.     dwnpay = calc2
  793.     payment = calc4
  794.     tempbal = calc3 - calc4
  795.     newbal = tempbal
  796.     current = calc5
  797.     
  798.     
  799.     
  800.     IF flagdate <= 0 THEN flagdate = 1' past due
  801.     IF flagdate >= 1 THEN flagdate = 0'current
  802.     RETURN
  803.      
  804.  
  805. scrupdate:
  806.     
  807.     LOCATE V(9), H(9): PRINT USING "####.##"; calc1
  808.     LOCATE V(10), H(10): PRINT USING "####.##"; dwnpay
  809.     LOCATE V(11), H(11): PRINT USING "####.##"; tempbal
  810.        
  811.     LOCATE V(12), H(12): PRINT USING "####.##"; current
  812.     LOCATE V(15), H(15): PRINT DATE$
  813.     LOCATE V(16), H(16): PRINT USING "####.##"; payment
  814.     COLOR bc%, fc%
  815.     LOCATE 15, 6: PRINT USING "$$####.##"; calc5
  816.     LOCATE 15, 17: PRINT USING "$$###.##"; thirty
  817.     LOCATE 15, 26: PRINT USING "$$###.##"; sixty
  818.     LOCATE 15, 35: PRINT USING "$$###.##"; ninety
  819.     LOCATE 15, 44: PRINT USING "$$####.##"; onetwenty
  820.     LOCATE 15, 60: PRINT USING "$$####.##"; newbal + thirty + sixty + ninety + onetwenty
  821.     j = 1: item% = j
  822.     COLOR fc%, bc%
  823.     RETURN
  824. exitedit:
  825.     GOSUB accounting: GOSUB scrupdate: GOSUB saveasis
  826.     GOSUB 11000: LOCATE 18, 5: COLOR fc%, bc%: PRINT " FUNCTION KEY COMMANDS "; : COLOR fc%, bc%
  827.     LOCATE 20, 26: COLOR fc%, bc%: PRINT "F1 = SAVE THIS FILE"; : LOCATE 21, 26: PRINT "F2 = CONTINUE EDITING"; : LOCATE 22, 26: PRINT "ESC = CANCEL AND EXIT "; : COLOR fc%, bc%: GOSUB 1000
  828.     IF a = 201 THEN GOSUB 9460: RETURN' SAVE FILE
  829.     IF a = 202 THEN GOTO enterdata
  830.     IF a = 27 THEN 9450' CANCEL
  831.     BEEP: GOTO exitedit
  832.  
  833. 9435 '
  834. 9450 LOCATE 1, 74: PRINT "    ";
  835.     FOR L% = 1 TO 16: LOCATE V(L%), H(L%):  PRINT SPC(LN(L%) + 2);
  836.     NEXT L%
  837.     
  838.     RETURN
  839. 9451 '
  840. 9460 center 15, STRING$(70, 32): IF ADD.REC% THEN GOSUB 6800 ELSE GOSUB 6540
  841. 9462 GOSUB 9450: RETURN
  842. 9500 'EDIT CLIENT REC HELP SCRN
  843. 9501 '
  844. 9502 FUNKEY$ = "    EDIT    ": GOSUB 8680: LOCATE 23, 65: COLOR fc%, bc%: PRINT STRING$(10, 205); : COLOR fc%, bc%
  845. 9505 GOSUB 11000: LOCATE 18, 5: COLOR fc%, bc%: PRINT " EDITING  KEY COMMANDS "; : COLOR fc%, bc%
  846. 9508 RETURN
  847. 9600 'INPUT CLIENT NUM
  848. 9601 '
  849. 9602 GOSUB 11000: PROMPT.LN% = 20
  850. 9604 CLIENT.NUM% = 0: LOCATE PROMPT.LN%, 17: COLOR fc%, bc%: PRINT "Enter CLIENT NUMBER and/or press [RET]"; SPC(14); : LOCATE PROMPT.LN%, 63: GOSUB 490
  851. 9606 COLOR fc%, bc%: LOCATE 25, 1: PRINT CLR$; : IF IN.STRING$ = "" THEN GOSUB 9700: RETURN
  852. 9608 IF REDRAW% THEN LOCATE PROMPT.LN%, 15: PRINT STRING$(64, 32);
  853. 9610 TOP.OF.DISP% = 18: LINES.IN.DISP% = 6: GOSUB 7300: IF REDRAW% THEN PROMPT.LN% = 25
  854. 9612 IF CLIENT.NUM% = 0 THEN 9604
  855. 9614 IF REC.NUM.ERR% OR BLANK.REC% THEN 9615 ELSE 9616
  856. 9615 LOCATE 23, 29: COLOR bc%, fc%: PRINT " No such CLIENT number ";
  857.     SOUND 50, 3
  858.      FOR T = 1 TO 2000
  859.      NEXT T
  860.      COLOR fc%, bc%: LOCATE 23, 29: PRINT STRING$(24, 205); : GOTO 9604
  861. 9616 GOSUB 9700: RETURN
  862. 9650 '
  863. 9700 'REDRAW BOTTOM OF CLIENT REC SCRN
  864. 9701 '
  865. 9702 IF REDRAW% = 0 THEN RETURN ELSE LOCATE 18, 1
  866.     FOR LP% = 1 TO 6: PRINT STRING$(80, 32)
  867.     NEXT LP%
  868. 9710 REDRAW% = 0: LOCATE 24, 15: PRINT STRING$(64, 32);
  869.      a$ = CHR$(192) + STRING$(77, 196) + CHR$(217)
  870.      LOCATE 17, 1: PRINT a$;
  871. 9712 RUL% = 18: RLR% = 23: BAR% = 2: COLOR fc%, bc%: GOSUB 35000: COLOR fc%, bc%: LOCATE 24, 1: PRINT STRING$(80, 32); : RETURN
  872. 9760 '
  873. 9780 '
  874. 9785 '
  875. 9800 'EDIT
  876. 9801 '
  877. 9810 GOSUB 9600: IF IN.STRING$ = "" THEN RETURN
  878. 9811 'Enter CLIENT edit
  879. 9812 LOCATE 1, 74: COLOR fc%, bc%: PRINT USING "####"; CLIENT.NUM%; : COLOR fc%, bc%
  880. 9814 FOR L% = 1 TO 16
  881. 9818 LOCATE V(L%), H(L%): IF LEFT$(API$(L%), 1) = CHR$(255) THEN PRINT STRING$(LN(L%), 46); : API$(L%) = CHR$(255): GOTO 9860
  882. 9820 COLOR fc%, bc%: PRINT API$(L%)
  883. 9822 FOR L1% = H(L%) + LN(L%) - 1 TO H(L%) STEP -1: IF SCREEN(V(L%), L1%) = 32 THEN LOCATE V(L%), L1%: PRINT " ";
  884. 9825 NEXT L1%
  885. 9857 API$(L%) = LEFT$(API$(L%), L1% - H(L%) + 1)
  886. 9860 NEXT L%
  887. GOSUB 9260: RETURN
  888.  
  889. 9865
  890. 9873 '
  891. 10000 'DEL
  892. 10001 '
  893. 10010 FUNKEY$ = "   DELETE ": GOSUB 8680: GOSUB 9600: IF IN.STRING$ = "" THEN GOSUB 8160: RETURN
  894. 10012 FOR L% = 1 TO 16: LOCATE V(L%), H(L%): PRINT API$(L%): NEXT L%
  895. 10014 GOSUB 11000: LOCATE 20, 22: COLOR fc%, bc%: PRINT "Delete this CLIENT (Y/N) ? "; : COLOR 31, bc%: PRINT CHR$(219); : COLOR fc%, bc%: GOSUB 1000: IF a = 78 OR a = 110 OR a = 27 THEN 10035
  896. 10018 IF a = 89 OR a = 121 THEN 10020 ELSE BEEP: GOTO 10012
  897. 10020 F$ = CLIENT.PATH$ + "RECORD.IDX": OPEN "R", #5, F$, 2: FIELD #5, 2 AS RI.LAST.REC$: LSET RI.LAST.REC$ = MKI$(0): PUT #5, CLIENT.NUM%: CLOSE #5
  898. 10022 F$ = CLIENT.PATH$ + LEFT$(API$(1), 1) + ".IDX": OPEN "R", #3, F$, 2: FIELD #3, 2 AS REC.PTR$: GET #3, 1: MAX.REC% = CVI(REC.PTR$)
  899. 10024 FOR L1% = 2 TO MAX.REC%
  900. 10025 GET #3, L1%: TST% = CVI(REC.PTR$): IF TST% <> CLIENT.NUM% THEN 10026
  901. 10026 NEXT L1%
  902. 10027 IF L1% = MAX.REC% THEN 10030
  903. 10028 GET #3, MAX.REC%: LAST% = CVI(REC.PTR$): LSET REC.PTR$ = MKI$(LAST%): PUT #3, L1%
  904. 10030 LSET REC.PTR$ = MKI$(MAX.REC% - 1): PUT #3, 1: CLOSE #3
  905. 10035 LOCATE 25, 1: PRINT CLR$; : GOSUB 9450: GOSUB 11000: GOSUB 8160: RETURN
  906. 10040 '
  907. 11000 'CLEAR CLIENT FILES HELP SCRN
  908. 11005 COLOR fc%, bc%
  909.     FOR V = 19 TO 22: LOCATE V, 2: PRINT SPC(77);
  910.     NEXT V
  911.     COLOR fc%, bc%
  912.     RETURN
  913. 13000 'READ MAX.REC IN .IDX FILES
  914. 13160 '
  915. 13170 OPEN "R", #3, index.file$, 2: FIELD #3, 2 AS AI.LAST.REC$: GET #3, 1: AI.LAST.REC% = CVI(AI.LAST.REC$): CLOSE #3: RETURN
  916. 13174 '
  917. 13200 'INCREMENT MAX.REC IN .IDX FILE
  918. 13201 '
  919. 13203 OPEN "R", #3, index.file$, 2: FIELD #3, 2 AS AI.LAST.REC$: GET #3, 1: AI.LAST.REC% = CVI(AI.LAST.REC$) + 1: LSET AI.LAST.REC$ = MKI$(AI.LAST.REC%): PUT #3, 1: LSET AI.LAST.REC$ = MKI$(CLIENT.NUM%): PUT #3, AI.LAST.REC%: CLOSE #3: ADD.REC% = 0 _
  920. : RETURN
  921.  
  922.  
  923. 'Calmod Joe Lincoln 6-85
  924. 30000 'CAL MOD
  925. 30002 '
  926. 30020 ' SEPARATE MONTH, DAY, AND YEAR FROM IN.STRING$
  927. 30030 DATE.ERR% = 0: MONTH.TP$ = "": DAY.TP$ = "": YEAR.TP$ = "": DATE.STR$ = ""
  928. 30040 '
  929. 30050 FOR LP% = 1 TO LEN(IN.STRING$)
  930. 30060 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
  931. 30070 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN MONTH.TP$ = MONTH.TP$ + CUR.CHR$
  932. 30072 NEXT LP%
  933. 30080 IF MONTH.TP$ = "" OR LEN(IN.STRING$) - LP% = 0 THEN 30200
  934. 30082 IF VAL(MONTH.TP$) > 12 THEN 30200
  935. 30090 FOR LP% = LP% + 1 TO LEN(IN.STRING$)
  936. 30110 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
  937. 30120 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN DAY.TP$ = DAY.TP$ + CUR.CHR$
  938. 30125 NEXT LP%
  939. 30130 'IF DAY.TP$="" OR LEN(IN.STRING$)-LP=0 THEN 30200
  940. 30140 FOR LP% = LP% + 1 TO LEN(IN.STRING$)
  941. 30150 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
  942. 30160 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN YEAR.TP$ = YEAR.TP$ + CUR.CHR$
  943. 30165 NEXT LP%
  944. 30170 IF YEAR.TP$ = "" THEN 30200
  945. 30180 MONTH.TP% = VAL(MONTH.TP$): DAY.TP% = VAL(DAY.TP$): YEAR.TP% = VAL(YEAR.TP$)
  946. 30190 GOSUB 30350: RETURN
  947. 30200 DATE.ERR% = 1: RETURN
  948. 30210 '
  949. 30220 'SEPARATE M/Y
  950. 30225 '
  951. 30230 DATE.ERR% = 0: MONTH.TP$ = "": YEAR.TP$ = ""
  952. 30240 FOR LP% = 1 TO LEN(IN.STRING$)
  953. 30250 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
  954. 30260 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN 30262 ELSE 30280
  955. 30262 MONTH.TP$ = MONTH.TP$ + CUR.CHR$
  956. 30265 NEXT LP%
  957. 30280 FOR LP% = LP% + 1 TO LEN(IN.STRING$)
  958. 30290 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
  959. 30300 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN 30302 ELSE 30310
  960. 30302 YEAR.TP$ = YEAR.TP$ + CUR.CHR$
  961. 30305 NEXT LP%
  962. 30310 IF YEAR.TP$ = "" THEN 30330
  963. 30320 MONTH.TP% = VAL(MONTH.TP$): YEAR.TP% = VAL(YEAR.TP$)
  964. 30325 DAY.TP$ = "1": DAY.TP% = 1: DATE.STR$ = MO$(MONTH.TP%) + " - 19" + YEAR.TP$: RETURN
  965. 30330 BEEP: DATE.ERR% = 1: RETURN
  966. 30340 '
  967. 30350 'VALID DATE
  968. 30351 '
  969. 30352 DATE.ERR% = 0: LY = 0: IF MONTH.TP% > 2 THEN 30356
  970. 30354 LY = 1: LE = 1: IF YEAR.TP% MOD 4 THEN LY = 2: LE = 0
  971. 30356 DC = INT(365.25 * YEAR.TP%) + INT(30.56 * MONTH.TP%) + LY + DAY.TP%: DW = 3 + DC - 7 * INT((DC + 2) / 7): MD(2) = 28 + LE: IF MONTH.TP% > 12 THEN 30362
  972. 30358  MAX.DAYS% = MD(MONTH.TP%): IF YEAR.TP% = 0 OR DAY.TP% > MAX.DAYS% THEN 30362
  973. 30360 DATE.STR.TP$ = MO$(MONTH.TP%) + " " + DAY.TP$ + ", 19" + LTRIM$(YEAR.TP$): RETURN
  974. 30362 DW = 8: DATE.ERR% = 1: RETURN
  975. 30364 '
  976. 30470 'CAL SCRN
  977. 30475 '
  978. 30530 GOSUB 30575: RETURN' Entry & Exit from cal
  979. 30560 DATE.STR$ = MO$(MONTH.TP%) + " - 19" + YEAR.TP$
  980. 30565 RETURN
  981. 30570 '
  982. 30575 CAL.ROW = 1: CAL.COL = 25: CAL.BG% = 1: CAL.FG% = 15: GOSUB 30855'DRAW BLANK CALENDAR
  983. 30576 RUL% = CAL.ROW + 17: CUL% = CAL.COL: RLR% = CAL.ROW + 22: CLR% = CAL.COL + 28: BAR% = 2: COLOR fc%, bc%: GOSUB 35000
  984. 30579 LOCATE CAL.ROW + 18, CAL.COL + 2: PRINT "ENTER MONTH/YEAR ": LOCATE CAL.ROW + 19, CAL.COL + 2: PRINT "Press RETURN for current"; : LOCATE CAL.ROW + 20, CAL.COL + 2: PRINT "Month.";
  985. 30583 LOCATE CAL.ROW + 18, CAL.COL + 20: fc% = 15: bc% = 1
  986. 30584 GOSUB 490: IF a = 27 THEN RETURN
  987. 30587 IF IN.STRING$ = "" THEN IN.STRING$ = LEFT$(DATE$, 2) + "-" + RIGHT$(DATE$, 2)
  988. 30591 GOSUB 30220: IF DATE.ERR% = 1 THEN BEEP: GOTO 30579
  989. 30595 GOSUB 30350: IF DATE.ERR% = 1 THEN BEEP: GOTO 30579
  990. 30599 GOSUB 30915 'UPDATE CALENDAR
  991. 30600 FOR V = CAL.ROW + 18 TO CAL.ROW + 21: LOCATE V, CAL.COL + 2: PRINT STRING$(26, 32): NEXT V
  992. 30604 LOCATE CAL.ROW + 20, CAL.COL + 3: PRINT "PGUP/PGDN Scrolls Month";
  993. 30605 LOCATE CAL.ROW + 21, CAL.COL + 6: COLOR fc%, bc%: PRINT "ESCape To Exit";
  994. 30607 '
  995. 30611 'CURSOR THRU CAL
  996. 30615 '
  997. 30619 LV = TOP.ROW%: CV = LV: LH = LEFT.COL% + DW * 4: IF DW = 7 THEN LH = LEFT.COL%
  998. 30623 CH = LH: GOSUB 30795: COLOR fc%, bc%
  999. 30627 a$ = INKEY$: IF a$ = "" THEN 30627 ELSE a = ASC(a$)
  1000. 30635 IF a = 27 THEN RETURN
  1001. 30643 EXT.CODE% = ASC(RIGHT$(a$, 1))
  1002. 30647 IF EXT.CODE% = 73 THEN GOSUB 30827: GOTO 30611' PGUP - NEXT MONTH
  1003. 30651 IF EXT.CODE% = 81 THEN GOSUB 30807: GOTO 30611' PGDN - PREVIOUS MONTH
  1004. 30671 BEEP: GOTO 30627
  1005. 30675 '
  1006. 30679 'Bail Out
  1007. 30683 '
  1008.     RETURN
  1009. 30791 '
  1010. 30795  LOCATE LV, LH: COLOR CAL.FG%, CAL.BG%: PRINT RIGHT$(STR$(CUR.DAY%), 2);
  1011. 30799  COLOR CAL.FG% + 16, CAL.BG%: LOCATE CV, CH: PRINT RIGHT$(STR$(DAY.TP%), 2); : LV = CV: LH = CH: CUR.DAY% = DAY.TP%: RETURN
  1012. 30803 '
  1013. 30807 'PREV MNTH
  1014. 30811 '
  1015. 30815 MONTH.TP% = MONTH.TP% - 1: IF MONTH.TP% < 1 THEN MONTH.TP% = 12: YEAR.TP% = YEAR.TP% - 1
  1016. 30819 GOTO 30843
  1017. 30823 '
  1018. 30827 'NEXT MNTH
  1019. 30831 '
  1020. 30835 MONTH.TP% = MONTH.TP% + 1: IF MONTH.TP% > 12 THEN MONTH.TP% = 1: YEAR.TP% = YEAR.TP% + 1
  1021. 30839 '
  1022. 30843 'DISP NEW MNTH
  1023. 30845 IF MONTH.TP% > 9 THEN MONTH.TP$ = RIGHT$(STR$(MONTH.TP%), 2) ELSE MONTH.TP$ = RIGHT$(STR$(MONTH.TP%), 1)
  1024. 30846 IF YEAR.TP% > 9 THEN YEAR.TP$ = RIGHT$(STR$(YEAR.TP%), 2) ELSE YEAR.TP$ = "0" + RIGHT$(STR$(YEAR.TP%), 1)
  1025. 30848 IN.STRING$ = MONTH.TP$ + "-" + YEAR.TP$: GOSUB 30220
  1026. 30851 DAY.TP% = 1: DATE.STR$ = MO$(MONTH.TP%) + " - 19" + RIGHT$(STR$(YEAR.TP%), 2): GOSUB 30350: GOSUB 30915: RETURN
  1027. 30855 'BLANK CAL
  1028.  
  1029. 30863 TOP.ROW% = CAL.ROW + 5: LEFT.COL% = CAL.COL + 2: RIGHT.COL% = LEFT.COL% + 24
  1030. 30867 COLOR CAL.FG%, CAL.BG%: TOP.ROW% = CAL.ROW + 5: FOR LP = 0 TO 22: LOCATE CAL.ROW + LP, CAL.COL: PRINT STRING$(30, 32); : NEXT LP' CLEAR AREA FOR CALENDAR
  1031. 30871 LOCATE CAL.ROW, CAL.COL: PRINT "╔═══════════════════════════╗";
  1032. 30875 LOCATE CAL.ROW + 1, CAL.COL: PRINT "║                           ║";
  1033. 30879 LOCATE CAL.ROW + 2, CAL.COL: PRINT "╟───┬───┬───┬───┬───┬───┬───╢";
  1034. 30883 LOCATE CAL.ROW + 3, CAL.COL: PRINT "║SUN│MON│TUE│WED│THU│FRI│SAT║";
  1035. 30887 LOCATE CAL.ROW + 4, CAL.COL: PRINT "╠═══╪═══╪═══╪═══╪═══╪═══╪═══╣";
  1036. 30891 FOR LP = 0 TO 10 STEP 2
  1037. 30895 LOCATE CAL.ROW + 5 + LP, CAL.COL: PRINT "║   │   │   │   │   │   │   ║";
  1038. 30899 LOCATE CAL.ROW + 6 + LP, CAL.COL: PRINT "╟───┼───┼───┼───┼───┼───┼───╢"; : NEXT LP
  1039. 30903 LOCATE CAL.ROW + 15, CAL.COL: PRINT "║   │   │   │   │   │   │   ║"
  1040. 30907 LOCATE CAL.ROW + 16, CAL.COL: PRINT "╚═══╧═══╧═══╧═══╧═══╧═══╧═══╝": RETURN
  1041.  
  1042. 30915 'UPDATE CAL
  1043.  
  1044. 30923 COLOR CAL.FG%, CAL.BG%: LOCATE CAL.ROW + 1, CAL.COL + 1: PRINT STRING$(27, 32); : LOCATE CAL.ROW + 1, CAL.COL + 15 - (INT(LEN(DATE.STR$) / 2)): PRINT DATE.STR$;
  1045. 30927 FOR VPOS% = TOP.ROW% TO TOP.ROW% + 10 STEP 2: FOR HPOS% = LEFT.COL% TO RIGHT.COL% STEP 4: LOCATE VPOS%, HPOS%: PRINT "  "; : NEXT HPOS%, VPOS%
  1046. 30931 CP% = LEFT.COL% + DW * 4: IF DW = 7 THEN CP% = LEFT.COL%
  1047. 30935 DAY1.COL% = CP%: VPOS% = TOP.ROW%: HPOS% = CP%
  1048. 30939 COLOR CAL.FG%, CAL.BG%: FOR x% = 1 TO 9: LOCATE VPOS%, HPOS% + 1: PRINT RIGHT$(STR$(x%), 1); : HPOS% = HPOS% + 4: IF HPOS% > RIGHT.COL% THEN HPOS% = LEFT.COL%: VPOS% = VPOS% + 2
  1049. 30943 NEXT x%: FOR x% = 10 TO MD(MONTH.TP%): LOCATE VPOS%, HPOS%: PRINT RIGHT$(STR$(x%), 2); : HPOS% = HPOS% + 4: IF HPOS% > RIGHT.COL% THEN HPOS% = LEFT.COL%: VPOS% = VPOS% + 2
  1050. 30947 NEXT x%: LAST.ROW% = VPOS%: LAST.COL% = HPOS% - 4: IF LAST.COL% < LEFT.COL% THEN LAST.COL% = RIGHT.COL%: LAST.ROW% = VPOS% - 2
  1051. 30951 RETURN
  1052. 30955 '
  1053. 35000 'FRAME ROUTINE
  1054. 35001 '
  1055. 35035 VBL% = (RLR% - 1) - (RUL%): HBL% = (CLR% - 1) - (CUL%): ON BAR% GOSUB 35065, 35125, 35185: RETURN
  1056. 35060 '-- BAR 1 IS SINGLE THIN BAR --
  1057. 35065 LOCATE RUL%, CUL%: PRINT ULC1$ + STRING$(HBL%, HB1$) + URC1$; : FOR I% = RUL% + 1 TO RUL% + VBL%: LOCATE I%, CLR%: PRINT VB1$; : NEXT
  1058. 35070 LOCATE RLR%, CUL%: PRINT LLC1$ + STRING$(HBL%, HB1$) + LRC1$; : FOR I% = RLR% - 1 TO RUL% + 1 STEP -1: LOCATE I%, CUL%: PRINT VB1$; : NEXT: RETURN
  1059. 35125 '-- BAR 2 IS DOUBLE THIN BARS --
  1060. 35130 LOCATE RUL%, CUL%: PRINT ULC2$ + STRING$(HBL%, HB2$) + URC2$; : FOR I% = RUL% + 1 TO RUL% + VBL%: LOCATE I%, CLR%: PRINT VB2$; : NEXT
  1061. 35155 LOCATE RLR%, CUL%: PRINT LLC2$ + STRING$(HBL%, HB2$) + LRC2$; : FOR I% = RLR% - 1 TO RUL% + 1 STEP -1: LOCATE I%, CUL%: PRINT VB2$; : NEXT: RETURN
  1062. 35185 '-- BAR 3 IS VERY BROAD --
  1063. 35190 LOCATE RUL%, CUL%: PRINT ULC3$ + STRING$(HBL%, HB3$) + URC3$; : FOR I% = RUL% + 1 TO RUL% + VBL%: LOCATE I%, CLR%: PRINT VB3$; : NEXT
  1064. 35215 LOCATE RLR%, CUL%: PRINT LLC3$ + STRING$(HBL%, HB3$) + LRC3$; : FOR I% = RLR% - 1 TO RUL% + 1 STEP -1: LOCATE I%, CUL%: PRINT VB3$; : NEXT: RETURN
  1065. 35245 '
  1066. 40000 'ERRORS
  1067.     SELECT CASE ERR
  1068.         CASE 4
  1069.             endofdata = TRUE
  1070.             RESUME NEXT
  1071.         CASE 25
  1072.             PRINT "Turn Printer On";
  1073.             PRINT " Press Any Key ";
  1074.             Pause$ = INPUT$(1)
  1075.             RESUME
  1076.         CASE 27
  1077.             PRINT "Printer is out of paper.";
  1078.             PRINT "Replace - Press Any Key.";
  1079.             Pause$ = INPUT$(1)
  1080.             RESTORE
  1081.             RESUME
  1082.         CASE 53
  1083.             a$ = "File not found...": center 24, a$
  1084.             SOUND 240, 2
  1085.             RESUME file.work
  1086.         CASE 52
  1087.             a$ = "Bad File Number..": center 24, a$
  1088.             SOUND 240, 2
  1089.             RESUME file.work
  1090.         CASE 75
  1091.             a$ = "Path/File not found...": center 24, a$
  1092.             SOUND 240, 2
  1093.             RESUME file.work
  1094.             
  1095.         CASE ELSE
  1096.             CLS : END
  1097.     END SELECT
  1098.  
  1099. 50000 '
  1100. 50002 'Logo
  1101. 50004 '
  1102. 50006 '
  1103. 50012 COLOR 4, 7: CLS
  1104. 50015 LOCATE 6, 1
  1105. 50020 'Display Screen
  1106.  
  1107.  
  1108.  PRINT "      ╔══════════════════════════════════════════════════════════════════╗   "
  1109.  PRINT "      ║                                                                  ║   "
  1110.  PRINT "      ║            █▀▀▀▀█      █               █     █                   ║   "
  1111.  PRINT "      ║            █    █  ▄▄  █▄▄▄▄ ▄   ▄ ▄▄▄▄█ ▄▄▄▄█ ▄   ▄             ║   "
  1112.  PRINT "      ║            █▄▄▄▄█      █▄▄▄█ █▄▄▄█ █▄▄▄█ █▄▄▄█ █▄▄▄█             ║   "
  1113.  PRINT "      ║               █▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█              ║   "
  1114.  PRINT "      ║                                                                  ║   "
  1115.  PRINT "      ╠══════════════════════════════════════════════════════════════════╣   "
  1116.  PRINT "      ║  I would like to thank Thomas Hanlen III for making ADVBAS40     ║   "
  1117.  PRINT "      ║  available to the public. I am developing a software package     ║   "
  1118.  PRINT "      ║  and had a few friends who wanted some pretty raw code in QB     ║   "
  1119.  PRINT "      ║  so I just put together a few of my current favorites that       ║   "
  1120.  PRINT "      ║  use many of the features of QB 4.0 and ADVBAS4 library stuff.   ║   "
  1121.  PRINT "      ║  This is a simple ACCOUNT'S RECEIVABLE module to be used with    ║   "
  1122.  PRINT "      ║                 QBUDDYSU.BAS     SetUp  Program                  ║   "
  1123.  PRINT "      ║                 QBUDDY14.BAS     This   Program                  ║   "
  1124.  PRINT "      ║  More to thank...not enough room. SHARE/TRASHCAN/COPY/CHANGE     ║   "
  1125.  PRINT "      ║    Joe Lincoln - LINX BBS (713) 440-7364 - Houston, Texas        ║   "
  1126.  PRINT "      ║                                                                  ║   "
  1127.  PRINT "      ╚══════════════════════════ Press any key ═════════════════════════╝   "
  1128.  GOSUB 1000
  1129. RETURN
  1130.  
  1131. SUB AppendFile (Filename$)
  1132. DEFAULT.FILE$ = "MEMOPAD.TXT"
  1133.     text$(1) = STRING$(74, 196)
  1134.     text$(2) = "Append entries in this file."
  1135.     text$(3) = "Press any key."
  1136.     text$(4) = "At the prompt (>) type one line and press RETurn."
  1137.     text$(5) = "To end, press RETurn without entering any data."
  1138.     CLS
  1139.     FOR row% = 1 TO 5
  1140.         LOCATE row% + 20, 3: PRINT text$(row%);
  1141.         NEXT row%
  1142.         LOCATE 22, 33: PRINT Filename$;
  1143.         VIEW PRINT 1 TO 20
  1144.         LOCATE 10, 28: PRINT "Press a key to begin.";
  1145.         anykey$ = INPUT$(1)
  1146.         CLS 2
  1147.         IF Filename$ = "" THEN EXIT SUB
  1148.         OPEN Filename$ FOR APPEND AS #1
  1149.     DO
  1150.         LINE INPUT "> "; record$
  1151.         PRINT
  1152.         IF record$ = "" THEN EXIT DO
  1153.         PRINT #1, record$
  1154.     LOOP
  1155.     CLOSE #1
  1156.     VIEW PRINT 1 TO 24
  1157. END SUB
  1158.  
  1159. SUB box (r1%, c1%, R2%, c2%, men%)
  1160.  
  1161. ' DRAW A BOX AT SPECIFIED COORDINATE
  1162.  
  1163.       GLOOP$ = "║"
  1164.       BOXTOP = (c2% - c1%) - 1: BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187)
  1165.       BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188)
  1166.       MIDBOX$ = CHR$(204) + STRING$(BOXTOP, 205) + CHR$(185)
  1167.       LOCATE r1%, c1%: PRINT BOXTOP$; : FOR E1% = r1% + 1 TO R2% - 1
  1168.       LOCATE E1%, c1%: PRINT GLOOP$; : LOCATE E1%, c2%: PRINT GLOOP$; : NEXT
  1169.       LOCATE R2%, c1%: PRINT BOXBOTTOM$;
  1170.       IF men% > 0 THEN   'Prints optional top and bottom bars in box
  1171.        LOCATE r1% + 3, c1%: PRINT MIDBOX$;
  1172.        LOCATE R2% - 2, c1%: PRINT MIDBOX$;
  1173.        END IF
  1174.  
  1175. END SUB
  1176.  
  1177. SUB box.text (tl$, r1%, c1%, fgd, bkg, ofg, obk)
  1178.      
  1179.       ' BOX TEXT AT SPECIFIED COORDINATE
  1180.       'This routine will box a one-line string of text in the color
  1181.       'of your choice at the starting coordinate you choose.
  1182.       'TL$ is the text, r1% is the starting row, c1% is the starting column.
  1183.       'fgd and bkg are the fore and background colors of the boxed text.
  1184.       'ofg and obk are the colors to restore after you've boxed the text.
  1185.        
  1186.        
  1187.     GLOOP$ = "║"
  1188.     BOXTOP = LEN(tl$) + 2
  1189.     BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187): BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188)
  1190.     MIDBOX$ = GLOOP$ + " " + tl$ + " " + GLOOP$
  1191.     COLOR fgd, bkg
  1192.     LOCATE r1%, c1%: PRINT BOXTOP$; : E1% = r1% + 1: R2% = E1% + 1
  1193.     LOCATE E1%, c1%: PRINT MIDBOX$;
  1194.     LOCATE R2%, c1%: PRINT BOXBOTTOM$;
  1195.     COLOR ofg, obk  'switch to these text colors after boxing the text
  1196.  
  1197. END SUB
  1198.  
  1199. SUB center (whichline, tl$)
  1200.  
  1201.  'This is a simple routine that centers a string of text TL$
  1202.  'on line number WHICHLINE. You can use it anywhere.
  1203.  
  1204.     tl = LEN(tl$)
  1205.     tl = INT((80 - tl) / 2)
  1206.     LOCATE whichline, tl
  1207.     PRINT tl$;
  1208.  
  1209.  
  1210. END SUB
  1211.  
  1212. SUB CreateFile (Filename$)
  1213. 'Create NotePad.DAT file.
  1214.  
  1215.     ' Put instructions
  1216.     text$(1) = STRING$(74, 196)
  1217.     text$(2) = "Create a new file called "
  1218.     text$(3) = "Press any key"
  1219.     text$(4) = "At the prompt (>), type one record and press enter."
  1220.     text$(5) = "To end press return without entering data."
  1221.     CLS
  1222.     FOR row% = 1 TO 5
  1223.         LOCATE row% + 20, 3: PRINT text$(row%);
  1224.     NEXT row%
  1225.         LOCATE 22, 29: PRINT Filename$;
  1226.     'Wait for a keypress to begin
  1227.     LOCATE 10, 28: PRINT "Press a key to begin.";
  1228.     anykey$ = INPUT$(1)
  1229.     CLS 2
  1230.  
  1231.     ' Define rows 1 to 20 as viewport
  1232.     VIEW PRINT 1 TO 20
  1233.  
  1234.     OPEN Filename$ FOR OUTPUT AS #1
  1235.  
  1236.     DO
  1237.         LINE INPUT "> "; record$
  1238.         PRINT
  1239.         IF record$ = "" THEN EXIT DO
  1240.         PRINT #1, record$
  1241.     LOOP
  1242.     CLOSE #1
  1243.  
  1244. END SUB
  1245.  
  1246. SUB Help (CLIENT.PATH$, APT.PATH$, PRINTER$, PROG.NAME$, VER$, fc%, bc%, SYS.PATH$)
  1247. CALL Sclr(fc%, bc%)
  1248. CALL getdosv(maj%, min%)
  1249. DRV$ = "x": CALL getdrv(DRV$)
  1250.  
  1251. a$ = "VARIABLE SYSTEM DEFAULTS": CALL center(6, a$)
  1252.     LOCATE 8, 5: PRINT "Doctor's Name          = "; PROG.NAME$;
  1253.     LOCATE 9, 5: PRINT "Printer                = "; PRINTER$;
  1254.     LOCATE 10, 5: PRINT "Accounting File Path   = "; CLIENT.PATH$;
  1255.     LOCATE 11, 5: PRINT "Appointment File Path  = "; APT.PATH$;
  1256.     LOCATE 12, 5: PRINT "Fore Color = "; fc%;
  1257.     LOCATE 12, 25: PRINT "Back Color = "; bc%;
  1258.     LOCATE 13, 5: PRINT "MS-DOS version = "; maj%; "."; min%;
  1259.     LOCATE 14, 5: PRINT "Default drive = "; DRV$;
  1260.  
  1261. a$ = STRING$(70, 22): CALL center(15, a$)
  1262. a$ = "CAUTION: When using SETUP procedures files can be ERASED.": CALL center(20, a$)
  1263. a$ = "                     Press any key               ": CALL center(23, a$)
  1264. Pause$ = INPUT$(1)
  1265. Sclr fc%, bc%
  1266. END SUB
  1267.  
  1268. SUB hold
  1269. WHILE INKEY$ = "": WEND
  1270.  
  1271. END SUB
  1272.  
  1273. SUB infile (CLIENT.PATH$, APT.PATH$, inflg%, Filename$, fc%, bc%, SYS.PATH$, ercd%, handle%, faccess%, mode%, SUB.PATH$)
  1274. SUB$ = STRING$(64, 0): DRV$ = "x"
  1275. DEFINT A-Z
  1276. 'Joe Lincoln - 3-88
  1277. init.infile:
  1278. Fil$ = SPACE$(12)
  1279. inflg% = 0: Filename$ = ""
  1280.     
  1281.  
  1282. begin.infile:
  1283.    LABEL$ = "Directories Scan ": V = 5
  1284.    LCOL% = 5: TROW% = 5: RCOL% = 79: BROW% = 20: PAGE% = 0: FRAME% = 1: ty% = 3
  1285. CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, PAGE%)
  1286.  
  1287. getdrive:
  1288.  
  1289.     a$ = "Wildcards are acceptable *.* ?": center 6, a$
  1290.     a$ = "Defaults to current directory": center 7, a$
  1291.     a$ = "Press RETurn to EXIT": center 8, a$
  1292.     LOCATE 14, 5: INPUT "Please enter search path and filespec:  "; IN.STR$
  1293. scandr:
  1294.     LABEL$ = "Directory Scan -> " + RTRIM$(IN.STR$): ty% = 2
  1295.     CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, PAGE%)
  1296.     
  1297.     Filename$ = UCASE$(IN.STR$)
  1298.  
  1299.    seekattr = 23 ' seek read-only, normal, hidden, system, and directory files
  1300.  
  1301.    CMD$ = Filename$
  1302.    IF CMD$ = "" THEN inflg% = 1: GOTO bail.out
  1303.  
  1304.    I = INSTR(CMD$, " ")
  1305.    IF I THEN Fil$ = LEFT$(CMD$, I - 1): CMD$ = MID$(CMD$, I + 1) ELSE Fil$ = CMD$: GOTO DoIt
  1306.  
  1307.    I = INSTR(CMD$, " ")
  1308.    IF I THEN parm1$ = LEFT$(CMD$, I - 1): CMD$ = MID$(CMD$, I + 1) ELSE parm1$ = CMD$: GOTO DoIt
  1309.  
  1310.    I = INSTR(CMD$, " ")
  1311.    IF I THEN parm2$ = LEFT$(CMD$, I - 1): parm3$ = MID$(CMD$, I + 1) ELSE parm2$ = CMD$
  1312.  
  1313. DoIt:
  1314.    IF parm1$ = "" THEN GOTO Display
  1315.    IF INSTR(parm1$, "/") THEN p$ = parm1$: GOSUB ExtractDate ELSE IF INSTR(parm1$, ":") THEN p$ = parm1$: GOSUB ExtractTime ELSE p$ = parm1$: GOSUB ExtractAttr
  1316.  
  1317.    IF parm2$ = "" THEN GOTO Display
  1318.    IF INSTR(parm2$, "/") THEN p$ = parm2$: GOSUB ExtractDate ELSE IF INSTR(parm2$, ":") THEN p$ = parm2$: GOSUB ExtractTime ELSE p$ = parm2$: GOSUB ExtractAttr
  1319.  
  1320.    IF parm3$ = "" THEN GOTO Display
  1321.    IF INSTR(parm3$, "/") THEN p$ = parm3$: GOSUB ExtractDate ELSE IF INSTR(parm3$, ":") THEN p$ = parm3$: GOSUB ExtractTime ELSE p$ = parm3$: GOSUB ExtractAttr
  1322.  
  1323. Display:
  1324.     a$ = STRING$(70, 32): center 23, a$
  1325.     Fil$ = Fil$ + CHR$(0)
  1326.     CALL FindFirstF(Fil$, seekattr, ercd%)
  1327.     IF ercd% THEN GOSUB uh.oh ELSE GOTO gofor.next
  1328.     GOTO begin.infile
  1329.     
  1330. gofor.next:
  1331.    WHILE ercd% = 0
  1332.     GOSUB DisplayFile
  1333.     CALL FindNextF(ercd%)
  1334.    WEND
  1335. stop.here:
  1336. 'A$ = STRING$(70, 32): center 23, A$
  1337.     a$ = "Press any key to continue": center 23, a$
  1338.     a$ = INKEY$: IF a$ = "" THEN GOTO stop.here
  1339.    GOTO bail.out
  1340.    
  1341. ExtractTime:
  1342.    I = INSTR(p$, ":")
  1343.    hour = VAL(p$)
  1344.    p$ = MID$(p$, I + 1)
  1345.    minute = VAL(p$)
  1346.    I = INSTR(p$, ":")
  1347.    IF I THEN Second = VAL(MID$(p$, I + 1))
  1348.    stime = -1
  1349.    RETURN
  1350.  
  1351. ExtractDate:
  1352.    I = INSTR(p$, "/")
  1353.    mnth = VAL(p$)
  1354.    p$ = MID$(p$, I + 1)
  1355.    day = VAL(p$)
  1356.    I = INSTR(p$, "/")
  1357.    IF I THEN year = VAL(MID$(p$, I + 1)) ELSE year = VAL(MID$(DATE$, 7))
  1358.    sdate = -1
  1359.    RETURN
  1360.  
  1361. ExtractAttr:
  1362.    attr = 0
  1363.    CALL upcase(p$)
  1364.    IF INSTR(p$, "R") THEN attr = attr + 1
  1365.    IF INSTR(p$, "H") THEN attr = attr + 2
  1366.    IF INSTR(p$, "S") THEN attr = attr + 4
  1367.    IF INSTR(p$, "D") THEN attr = attr + 16
  1368.    IF INSTR(p$, "A") THEN attr = attr + 32
  1369.    sattr = -1
  1370.    RETURN
  1371.  
  1372. DisplayFile:
  1373.    V = V + 1
  1374.    KY$ = INKEY$
  1375.    IF KY$ = CHR$(19) THEN WHILE INKEY$ = "": WEND  '  handle CTRL-S for pause
  1376.    dname$ = SPACE$(12)
  1377.    CALL GetNameF(dname$, dlen)
  1378.    CALL GetTimeF(dhour, dmin, dsec)
  1379.    CALL GetDateF(dmnth, dday, dyear)
  1380.    CALL GetAttrF(dattr)
  1381.    IF V >= 20 THEN V = 6: GOSUB wait.up
  1382.    LOCATE V, 5: PRINT dname$; "   "; fnf$(dmnth); "/"; fnf$(dday); "/"; fnf$(dyear); "   "; fnf$(dhour); ":"; fnf$(dmin); ":"; fnf$(dsec); "   ";
  1383.    pattr = dattr: GOSUB DisplayAttr
  1384.    IF NOT (sdate OR stime OR sattr) THEN RETURN
  1385.  
  1386.    dname$ = LEFT$(dname$, dlen) + CHR$(0)
  1387.    PRINT "   ------>     ";
  1388.  
  1389.    IF sdate AND NOT stime THEN hour = dhour: minute = dmin: Second = dsec
  1390.    IF stime AND NOT sdate THEN day = dday: mnth = dmnth: year = dyear
  1391.  
  1392.    IF sdate OR stime THEN CALL setftd(dname$, mnth, day, year, hour, minute, Second)
  1393.    IF sdate THEN PRINT fnf$(mnth); "/"; fnf$(day); "/"; fnf$(year); "   ";  ELSE PRINT SPACE$(11);
  1394.    IF stime THEN PRINT fnf$(hour); ":"; fnf$(minute); ":"; fnf$(Second); "   ";  ELSE PRINT SPACE$(11);
  1395.  
  1396.    IF NOT sattr THEN RETURN
  1397.    IF sattr THEN CALL SetFattr(dname$, attr)
  1398.    pattr = attr: GOSUB DisplayAttr
  1399.    RETURN
  1400.  
  1401. DisplayAttr:
  1402.    IF pattr = 0 THEN PRINT "N";
  1403.    IF pattr AND 1 THEN PRINT "R";
  1404.    IF pattr AND 2 THEN PRINT "H";
  1405.    IF pattr AND 4 THEN PRINT "S";
  1406.    IF pattr AND 16 THEN PRINT "D";
  1407.    IF pattr AND 32 THEN PRINT "A";
  1408.    RETURN
  1409.  
  1410. wait.up:
  1411.     a$ = STRING$(70, 32): center 23, a$
  1412.     a$ = "Tap a key": center 23, a$: SOUND 250, 2
  1413.     a$ = INPUT$(1)
  1414.     RETURN
  1415. uh.oh:
  1416. CALL upcase(Fil$): a$ = "Path not found to  " + Fil$ + "  -> Press any key": center 12, a$
  1417. RETURN
  1418. bad.news:
  1419.     a$ = INPUT$(1)
  1420.     inflg% = 1
  1421.  
  1422. bail.out:
  1423.       
  1424. END SUB
  1425.  
  1426. DEFSNG A-Z
  1427. SUB memomenu
  1428. END SUB
  1429.  
  1430. SUB menu (fgd, BKGD, brdr, CLIENT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, VER$, fc%, bc%, today.date.str$, inflg%, SYS.PATH$)
  1431.  
  1432. 'This is the heart of the program.
  1433.  
  1434. COLOR fgd, BKGD, brdr
  1435.       REM
  1436.       REM
  1437. step1:
  1438.       a$ = VER$
  1439.       CALL center(23, a$)
  1440.       a$ = today.date.str$
  1441.       LOCATE 2, 60: PRINT a$;
  1442.       row = 8: col = 20: '     SET ROW AND COLUMN FOR MENU
  1443.       C1F = fgd: C1B = BKGD'   SET COLOR CODES
  1444.       C2F = BKGD: C2B = fgd: '       SET BAR COLOR TO COLOR 0,2
  1445.       'M$(1) = "ADD A NAME": M$(2) = "UPDATE A NAME": M$(3) = "DELETE A NAME": M$(4) = "FIND A NAME": M$(5) = "FILTER THE LIST": M$(6) = "SORT THE LIST": M$(7) = "PRINT THE LIST": M$(8) = "QUIT THE PROGRAM"
  1446.       'np = 8:
  1447.       '
  1448. step2:
  1449.  
  1450. GOSUB step3
  1451.       CLS
  1452.       GOTO menu.end
  1453.       GOTO step1
  1454.       GOTO step2
  1455.       '
  1456.       '
  1457. step3:
  1458.       COLOR C1F, C1B: ' CLS
  1459.       CALL center(7, "MENU SELECTIONS")
  1460.       CALL center(row + 1, "Use <ARROWS> to select <ENTER> to Choose")
  1461.  
  1462.       FOR j = 1 TO 16: x$ = INKEY$: NEXT: CH = 1
  1463.       LS = 2: FOR j = 1 TO np: IF LEN(m$(j)) > LS THEN LS = LEN(m$(j))
  1464.       NEXT: ML$ = "##  \" + SPACE$(LS - 1) + "\": SL = col + 18 - LEN(ML$) / 2
  1465.       FOR K = 1 TO np: LOCATE row + 2 + K, SL: PRINT USING ML$; K, m$(K): NEXT
  1466. step4:
  1467.     LOCATE row + 2 + CH, SL: COLOR C2F, C2B: PRINT USING ML$; CH, m$(CH): COLOR C1F, C1B: TD = CH
  1468. step5:
  1469.       CALL getkbd(INSERT%, capslock%, numlocl%, scrolock%)
  1470.     IF capslock% THEN LOCATE 24, 56: PRINT "CAPS";  ELSE LOCATE 24, 56: PRINT "    ";
  1471.     IF numlocl% THEN LOCATE 24, 62: PRINT "NUM";  ELSE LOCATE 24, 62: PRINT "    ";
  1472.     IF scrolock% THEN LOCATE 24, 68: PRINT "SCRL";  ELSE LOCATE 24, 68: PRINT "     ";
  1473.     IF INSERT% THEN LOCATE 24, 50: PRINT "INS";  ELSE LOCATE 24, 50: PRINT "    ";
  1474.      
  1475. CALL tyme
  1476.       x$ = INKEY$: IF LEN(x$) THEN KP = ASC(RIGHT$(x$, 1)) ELSE GOTO step5
  1477.      
  1478.       IF KP = 72 THEN CH = CH - 1: IF CH < 1 THEN CH = np
  1479.       IF KP = 80 THEN CH = CH + 1: IF CH > np THEN CH = 1
  1480.       IF x$ >= "1" AND x$ <= "9" THEN IF VAL(x$) >= 1 AND VAL(x$) <= np THEN CH = VAL(x$): RETURN
  1481.       IF KP = 13 THEN RETURN
  1482.       IF KP <> 72 AND KP <> 80 THEN KP = KP - 48: IF KP < 1 OR KP > np THEN PRINT CHR$(7): GOTO step5 ELSE CH = KP
  1483.       IF CH = TD THEN GOTO step5 ELSE LOCATE row + 2 + TD, SL: PRINT USING ML$; TD, m$(TD): GOTO step4
  1484.  
  1485. menu.end:
  1486.  
  1487. END SUB
  1488.  
  1489. SUB PrintFile (Filename$)
  1490.     text$(1) = STRING$(74, 196)
  1491.     text$(2) = "Print the file to the printer."
  1492.     text$(3) = "Make sure the printer is ready and press any key."
  1493.     text$(4) = "To interrupt hold down the Q key."
  1494.     CLS
  1495.     FOR row% = 1 TO 5
  1496.         LOCATE row% + 20, 3: PRINT text$(row%);
  1497.     NEXT row%
  1498.     VIEW PRINT 1 TO 20
  1499.     LOCATE 10, 28: PRINT "Press a key to begin."
  1500.     LOCATE 22, 34: PRINT Filename$;
  1501.     anykey$ = INPUT$(1)
  1502.     CLS 2
  1503.     OPEN Filename$ FOR INPUT AS #1
  1504.     DO UNTIL EOF(1)
  1505.         kbd$ = INKEY$: IF UCASE$(kbd$) = "Q" THEN EXIT DO
  1506.         LINE INPUT #1, record$
  1507.         PRINT record$
  1508.         LPRINT record$
  1509.     LOOP
  1510.     CLOSE #1
  1511.  
  1512. END SUB
  1513.  
  1514. SUB rmsg (whichline, tl$)
  1515. 'This routine also centers a string of text TL$ on line number WHICLINE.
  1516. 'Unlike the CENTER subroutine, it clears the line before printing the
  1517. 'centered text. You can use this anywhere, too."
  1518.  
  1519.        
  1520.     tl = LEN(tl$)
  1521.     tl = INT((80 - tl) / 2)
  1522.     LOCATE whichline, 2
  1523.     PRINT STRING$(77, 32);
  1524.     LOCATE whichline, tl
  1525.     PRINT tl$;
  1526.  
  1527. END SUB
  1528.  
  1529. SUB ScanFile (Filename$)
  1530.     text$(1) = STRING$(74, 196)
  1531.     text$(2) = "Scan the file, one line at a time."
  1532.     text$(3) = "Press any key."
  1533.     text$(4) = "Starts with the first record in the viewport."
  1534.     text$(5) = "Press SPACE BAR for next record, Q to quit."
  1535.     CLS
  1536.     FOR row% = 1 TO 5
  1537.            
  1538.         LOCATE row% + 20, 3: PRINT text$(row%);
  1539.         NEXT row%
  1540.         LOCATE 22, 38: PRINT Filename$;
  1541.         VIEW PRINT 1 TO 20
  1542.        OPEN Filename$ FOR INPUT AS #1
  1543.        DO UNTIL EOF(1)
  1544.         LINE INPUT #1, record$
  1545.         PRINT record$
  1546.         PRINT
  1547.         nextkey$ = INPUT$(1)
  1548.         IF UCASE$(nextkey$) = "Q" THEN EXIT DO
  1549.        LOOP
  1550.        CLOSE #1
  1551.        END SUB
  1552.  
  1553. SUB Sclr (fc%, bc%)
  1554. FOR V = 5 TO 21: LOCATE V, 3: COLOR fc%, bc%: PRINT STRING$(76, 32)
  1555. NEXT V
  1556. END SUB
  1557.  
  1558. SUB tyme
  1559. TT$ = TIME$
  1560. Hr = VAL(TT$)
  1561. IF Hr < 12 THEN Ampm$ = "AM" ELSE Ampm$ = "PM"
  1562. IF Hr > 12 THEN Hr = Hr - 12
  1563. LOCATE 2, 4: PRINT STR$(Hr); RIGHT$(TT$, 6); Ampm$
  1564. END SUB
  1565.  
  1566.